# load libraries
library(tidyverse)
library(here)
library(ggpmisc)
library(ggrepel)
library(ggbeeswarm)

Cleaning Data:

# Read the data
tl <- read_csv(here("data/Tulai_Lithic_Assamblage.csv"))

# Create a new data frame with renamed columns
tl1 <- tl
names(tl1)[1:2] <- c("lithic_id", 
                     "TA")

# modify TA column
tl1 <- tl1 %>%
  # Remove everything within brackets
  mutate(TA = str_remove_all(TA, 
                             "\\(.*\\)")) %>%  
  
  # Add slash between TA and numbers
  mutate(TA = str_replace_all(TA, 
                              "TA([0-9]+)", 
                              "TA/\\1")) %>% 
  # Add slash between numbers
  mutate(TA = str_replace_all(TA, 
                              "([0-9]+)/([0-9]+)", "\\1/\\2")) %>% 
 # fill NA values in TA column
  tidyr::fill(TA, .direction = "down") %>%
  # Prepend 'TA/' to numbers
  mutate(TA = if_else(str_detect(TA, 
                                 "^[0-9]+$"), 
                      paste0("TA/",
                             TA), 
                      TA)) %>% 
  # Remove all non-alphanumeric characters
  mutate(TA = str_replace_all(TA, 
                              "[^[:alnum:] /]", 
                              "")) %>% 
  # Make all text lowercase
  mutate(TA = tolower(TA)) %>% 
  # Remove white space
  mutate(TA = str_replace_all(TA, " ", ""))  %>%
  # Separate 'TA' column into 'area' and 'depth' columns
  separate(TA, into = c("area", 
                        "depth"), 
           sep = "/",
           remove = FALSE,
           convert = TRUE) %>%
  # Convert 'depth' to numeric
  mutate(depth = as.numeric(depth)) %>% 
  # Create depth ranges
  mutate(depth = case_when(
             depth == 3 ~ "0-30 cm",
             depth == 34 ~ "30-40 cm",
             depth == 45 ~ "40-50 cm",
             depth == 56 ~ "50-60 cm",
             depth == 67 ~ "60-70 cm",
             depth == 72 ~ "70-120 cm",
             depth == 125 ~ "120-150 cm",
             depth == 158 ~ "150-180 cm",
             depth == 189 ~ "180-190 cm",
             depth == 190 ~ "190-200 cm",
             depth == 201 ~ "200-210 cm",
             depth == 212 ~ "210-220 cm",
             depth == 223 ~ "220-230 cm",
             depth == 234 ~ "230-240 cm",
             depth == 235 ~ "230-250 cm",
             depth == 256 ~ "250-260 cm",
             depth == 267 ~ "260-270 cm",
             depth == 72 ~ "70-120 cm",
             depth == 1 ~ "0-10 cm",
             depth == 2 ~ "0-20 cm", 
             depth == 13 ~ "10-30 cm",
             depth == 19 ~ "10-90 cm",
             depth == 23 ~ "20-30 cm",
             depth == 34 ~ "30-40 cm",
             depth == 45 ~ "40-50 cm",
             depth == 51 ~ "50-100 cm",
             depth == 56 ~ "50-60 cm",
             depth == 57 ~ "50-70 cm",
             depth == 89 ~ "80-90 cm",
             depth == 91 ~ "90-100 cm",
             depth == 101 ~ "100-110 cm",
             depth == 112 ~ "110-120 cm",
             depth == 123 ~ "120-130 cm",
             depth == 124 ~ "120-140 cm",
             depth == 23 ~ "20-30 cm",
             depth == 46 ~ "40-60 cm",
             depth == 78 ~ "70-80 cm",
             depth == 235 ~ "230-250 cm",
             depth == 12 ~ "10-20 cm",
             depth == 90 ~ "90-100 cm",
             
             TRUE ~ as.character(depth)
  )) %>% 
  
  
  
  separate(depth, 
           into = c("upper",
                    "lower"),
           sep = "-",
           remove = FALSE,
           convert = TRUE) %>% 
  mutate(lower = parse_number(lower)) %>% 
  rowwise() %>% 
  mutate(midpoint = mean(c(upper, lower))) %>%
# create 'layer' column
  mutate(layer = case_when(
      area == "tp1" & depth == "0-10 cm" ~ "c",
      area == "tp1" & depth == "0-20 cm" ~ "c",
      area == "tp1" & depth == "10-30 cm" ~ "c",
      area == "tp1" & depth == "10-90 cm" ~ "c",
      area == "tp1" & depth == "20-30 cm" ~ "c",
      area == "tp1" & depth == "30-40 cm" ~ "c",
      area == "tp1" & depth == "40-50 cm" ~ "c",
      area == "tp1" & depth == "50-100 cm" ~ "c",
      area == "tp1" & depth == "50-60 cm" ~ "c",
      area == "tp1" & depth == "50-70 cm" ~ "c",
      area == "tp1" & depth == "80-90 cm" ~ "c",
      area == "tp1" & depth == "90-100 cm" ~ "c",
      area == "tp1" & depth == "100-110 cm" ~ "c",
      area == "tp1" & depth == "110-120 cm" ~ "c",
      area == "tp1" & depth == "120-130 cm" ~ "c",
      area == "tp1" & depth == "120-140 cm" ~ "c",
      area == "d1" & depth == "0-20 cm" ~ "c",
      area == "d1" & depth == "20-30 cm" ~ "c",
      area == "d1" & depth == "40-60 cm" ~ "a",
      area == "d1" & depth == "50-60 cm" ~ "a",
      area == "d1" & depth == "60-70 cm" ~ "a",
      area == "d1" & depth == "70-80 cm" ~ "a",
      area == "ta" & depth == "0-30 cm" ~ "e",
      area == "ta" & depth == "30-40 cm" ~ "e",
      area == "ta" & depth == "40-50 cm" ~ "e",
      area == "ta" & depth == "50-60 cm" ~ "e",
      area == "ta" & depth == "60-70 cm" ~ "e",
      area == "ta" & depth == "70-120 cm" ~ "d",
      area == "ta" & depth == "120-150 cm" ~ "d",
      area == "ta" & depth == "150-180 cm" ~ "d",
      area == "ta" & depth == "180-190 cm" ~ "d",
      area == "ta" & depth == "190-200 cm" ~ "d",
      area == "ta" & depth == "200-210 cm" ~ "d",
      area == "ta" & depth == "210-220 cm" ~ "d",
      area == "ta" & depth == "220-230 cm" ~ "d",
      area == "ta" & depth == "230-240 cm" ~ "d",
      area == "ta" & depth == "230-250 cm" ~ "d",
      area == "ta" & depth == "250-260 cm" ~ "d",
      area == "ta" & depth == "260-270 cm" ~ "d",
     
      TRUE ~ NA_character_
  ))


# Remove specific columns
tl1 %>% 
  select(-c("AREA", 
            "DEPTH (cm)", 
            "Raw Material", 
            "Colour/Grain/Opacity", 
            "Pattern"))
# A tibble: 3,920 × 36
# Rowwise: 
   lithic_id TA    area  depth    upper lower `Cortex (%)` `Weight (g)`
   <chr>     <chr> <chr> <chr>    <int> <dbl>        <dbl> <lgl>       
 1 1         ta/34 ta    30-40 cm    30    40            0 NA          
 2 2         ta/34 ta    30-40 cm    30    40            0 NA          
 3 3         ta/34 ta    30-40 cm    30    40            0 NA          
 4 4         ta/34 ta    30-40 cm    30    40            0 NA          
 5 5         ta/34 ta    30-40 cm    30    40            0 NA          
 6 6         ta/34 ta    30-40 cm    30    40            0 NA          
 7 9         ta/34 ta    30-40 cm    30    40            0 NA          
 8 10        ta/34 ta    30-40 cm    30    40            0 NA          
 9 11        ta/34 ta    30-40 cm    30    40           10 NA          
10 12        ta/34 ta    30-40 cm    30    40            0 NA          
# ℹ 3,910 more rows
# ℹ 28 more variables: `Length (mm)` <dbl>, `Width (mm)` <dbl>,
#   `Thickness (mm)` <chr>, `Bulb Thickness (mm)` <chr>,
#   `Platform Thickness (mm)` <chr>, `platform Length (mm)` <chr>,
#   Eraillure <chr>, Typology <chr>, Utilization <chr>, Retouch <dbl>,
#   `Retouch Position` <chr>, `Retouch Localization` <chr>,
#   `Retouch Distribution` <chr>, `Retouch Intensity` <chr>, …
# exploring Data

tl1 %>% 
  group_by(midpoint) %>% 
  tally() %>% 
  drop_na(midpoint) %>% 
ggplot() + 
  aes(midpoint, n) +
  geom_col()

# exploring Data

tl1 %>% 
  group_by(layer) %>% 
  tally() %>% 
  drop_na(layer) %>% 
ggplot() + 
  aes(layer, n) +
  geom_col()

# exploring Data

tl2 <- tl1 %>%
  mutate(
    Blank = case_when(
      Breakage %in% c("0", "1", NA_character_) ~ Blank,  
      
      TRUE ~ Breakage  
    )
  )
# Cleaning Blank column

tl2 <- tl2 %>%
  mutate(
    Blank = str_to_lower(Blank),
    Blank = str_trim(Blank),
    Blank = str_replace_all(Blank, "[./]", "-"),
    Blank = str_replace_all(Blank, "\\s*-\\s*", "-")
  ) %>%
  mutate(Blank = case_when(
             Blank == "peo" ~                      "bladelet-pro",
             Blank == "pro" ~                      "bladelet-pro",
             Blank == "bladelet-dis" ~             "bladelet-dis",
             Blank == "microblade" ~               "bladelet-complete",
             Blank == "microblade-pro" ~           "bladelet-pro",
             Blank == "microblade-med" ~           "bladelet-med",
             Blank == "micrpblade-dis" ~           "bladelet-dis",
             Blank == "dis" ~                      "bladelet-dis",
             Blank == "bladelrt-med" ~             "bladelet-med",
             Blank == "bladelet-mes" ~             "bladelet-med",
             Blank == "bladelet-,ed" ~             "bladelet-med",
             Blank == "bladelet-bladelet-med" ~    "bladelet-med",
             Blank == "medial" ~                   "bladelet-med",
             Blank == "bladelet-bladelet-pro" ~    "bladelet-pro",
             Blank == "bladelert-pro" ~            "bladelet-pro",
             Blank == "microblade-medial" ~        "bladelet-med",
             Blank == "nicroblade-pro" ~           "bladelet-pro",
             Blank == "microblade-?" ~             "bladelet-complete",
             Blank == "med" ~                      "bladelet-med",
             Blank == "bladeler-pro" ~             "bladelet-pro",
             Blank == "microblade-dis" ~           "bladelet-dis",
             Blank == "microblde-dis" ~            "bladelet-dis",
             Blank == "bladlet-pro" ~              "bladelet-pro",
             Blank == "indistinct" ~               "bladelet-med",
             Blank == "flake" ~                    "flake-complete",
             Blank == "dladelet-pro" ~             "bladelet-pro",
             Blank == "dladelet-pro" ~             "bladelet-pro",
             Blank == "bldelet-bladelet-pro" ~     "bladelet-pro",
             Blank == "bldelet-pro" ~              "bladelet-pro",
             Blank == "nicroblade-pro" ~           "bladelet-pro",
             Blank == "microblade-?" ~             "bladelet-med",
             Blank == "bladelt-pro" ~              "bladelet-pro",
             Blank == "bladeket-med" ~             "bladelet-med",
             Blank == "nicroblade-pro" ~           "bladelet-pro",
             Blank == "blaelet" ~                  "bladelet-complete",
             Blank == "bladele-med" ~              "bladelet-med",
             Blank == "bladelet-nearly complete" ~ "bladelet-complete",
             Blank == "blade-nearly complete" ~    "blade-complete",
             Blank == "bladelet-?" ~               "bladelet-complete",
             Blank == "flake?" ~                   "flake-complete",
             Blank == "micrpblade-dis" ~           "bladelet-dis",
             Blank == "blaelet-med" ~              "bladelet-med",
             Blank == "blaedlet-pro" ~             "bladelet-pro",  
             Blank == "bladelt-pro" ~              "bladelet-pro",   
             Blank == "bladelet-nearly complete"~  "bladelet-complete", 
             Blank == "microblade-med" ~           "bladelet-med", 
             Blank == "bldelet-bladelet-pro" ~     "bladelet-pro",
             Blank == "bldelet-flake" ~            "blade-complete",
             Blank == "mwdial" ~                   "bladelet-med",
             Blank == "blade" ~                    "blade-complete",
             Blank == "bladelt" ~                  "bladelet-complete",
             Blank == "bladlet" ~                  "bladelet-complete",
             Blank == "bladlet-med" ~              "bladelet-med",
             Blank == "bladelt-med" ~              "bladelet-med",
             Blank == "flaje" ~                    "flake",
             Blank == "flke" ~                     "flake",
             Blank == "bladelet" ~                 "bladelet-complete",
             Blank == "NA" ~                       "bladelet-",
             Blank == "thick flake" ~              "flake",
             Blank == "flke-mid" ~                 "flake-med",
             Blank == "flake-blade" ~              "flake",
             Blank == "angular flake?" ~           "flake",
             Blank == "flake-prox" ~               "flake-pro",
             Blank == "fklae-dis" ~                "flake-dis",
             Blank == "bladelete" ~                "bladelet",
             Blank == "NA" ~                    NA_character_,
    TRUE ~ Blank
  )) %>%
  mutate(Blank = na_if(Blank, ""))
             
rev(sort(table(tl2$Blank)))

             bladelet-pro              bladelet-med              bladelet-dis 
                     1461                       660                       333 
        bladelet-complete              bladelet-mid            flake-complete 
                      299                       279                       179 
                blade-med            blade-complete                 blade-pro 
                       83                        76                        71 
                blade-dis                 blade-mid                 flake-dis 
                       42                        35                        26 
                flake-med                     flake                 flake-pro 
                       14                        13                        10 
             baldelet-mid             bladelete-pro               bladele-pro 
                        8                         5                         5 
             baldelet-pro                         ?               bladelet-po 
                        4                         4                         3 
                flake-mid                     debri                     chunk 
                        2                         2                         2 
              bldelet-mid              bladrlet-mid               bladlet-mid 
                        2                         2                         2 
              bladelt-dis              bladelet-prp              bladelet pro 
                        2                         2                         2 
             baldelet-dis              vladelet-mid    naturally backed flake 
                        2                         1                         1 
naturally backed bladelet               ladelet-pro                  flakemed 
                        1                         1                         1 
              falke-blade                     falke                  dihedral 
                        1                         1                         1 
             denticulate?                     chip?             blsadelet-pro 
                        1                         1                         1 
                blelt-mid              bldelety-pro               blaelet-pro 
                        1                         1                         1 
              bladlet-dis                 bladerlet              bladelte-mid 
                        1                         1                         1 
             bladelte-dis               bladelt-mid               bladeletmid 
                        1                         1                         1 
             bladelet0pro               bladelet-ro             bladelet-meid 
                        1                         1                         1 
              bladelet-md               bladelet-is               bladelet-ed 
                        1                         1                         1 
             bladeler-mid                   bladele                bladel-dis 
                        1                         1                         1 
             blade;et-pro                  blade;et             blade-pro-mid 
                        1                         1                         1 
                 blade-md               blade-flake             bladaelet-mid 
                        1                         1                         1 
             baldelet-med                  baldelet               badelet-med 
                        1                         1                         1 
                 bade-dis 
                        1 
# BM: still many typos and unusual categories in here, why is that? Can they be fixed?

tl3 <- tl2 %>%
  separate(Blank, 
           into = c("Blank2", "Blank_part"),
           sep = "-",
           remove = FALSE,
           convert = TRUE)

na_rows <- which(is.na(tl2$Blank))
print(na_rows)
  [1]   21  355  367  368  369  370  489  490  491  492  493  494  495  496  497
 [16]  498  543  572  573  644  647  648  649  650  651  652  653  654  694  721
 [31]  722  723  724  725  726  727  843  851  853  856  857  858  862  863  866
 [46]  867  871  872  874  875  876  877  880  881  882  883  884  953  954 1030
 [61] 1031 1070 1071 1072 1073 1075 1076 1077 1170 1310 1311 1312 1443 1444 1445
 [76] 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460
 [91] 1461 1462 1463 1464 1465 1540 1599 1604 1605 1611 1614 1622 1624 1626 1912
[106] 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 2132 2133 2134 2135 2136
[121] 2137 2139 2140 2141 2142 2143 2144 2146 2148 2150 2151 2152 2153 2154 2155
[136] 2156 2157 2158 2159 2160 2161 2162 2237 2244 2251 2253 2274 2339 2340 2346
[151] 2365 2391 2398 2403 2422 2425 2435 2436 2437 2438 2439 2440 2441 2442 2443
[166] 2444 2445 2446 2447 2448 2449 2450 2451 2534 2545 2559 2565 2581 2582 2583
[181] 2584 2585 2586 2589 2590 2591 2593 2595 2622 2771 2772 2794 2796 2797 2801
[196] 2802 2825 2830 2836 2850 2877 2912 2934 2935 2936 2937 2938 2939 2942 2943
[211] 2944 2945 2947 2948 2950 2951 2952 2954 3159 3160 3166 3169 3240 3244 3270
[226] 3271 3283 3300 3302 3388 3407 3430 3431 3432 3434 3435 3437 3438 3439 3440
[241] 3442 3444 3492 3531 3894 3895 3896 3897 3898 3899 3900
zero_rows <- which(tl2$Blank == "0")
print(zero_rows)
integer(0)
one_rows <- which(tl2$Blank == "1")
print(one_rows)
integer(0)
rev(sort(table(tl3$Blank2))) # BM: still a lot of typos on the categories here, can you fix them?

                 bladelet                     blade                     flake 
                     3042                       310                       244 
                 baldelet                   bladele                 bladelete 
                       16                         6                         5 
                        ?                   bladlet                   bladelt 
                        4                         3                         3 
                    falke                     debri                     chunk 
                        2                         2                         2 
                  bldelet                  bladrlet                  bladelte 
                        2                         2                         2 
             bladelet pro                  blade;et                  vladelet 
                        2                         2                         1 
   naturally backed flake naturally backed bladelet                   ladelet 
                        1                         1                         1 
                 flakemed                  dihedral              denticulate? 
                        1                         1                         1 
                    chip?                 blsadelet                     blelt 
                        1                         1                         1 
                 bldelety                   blaelet                 bladerlet 
                        1                         1                         1 
              bladeletmid              bladelet0pro                  bladeler 
                        1                         1                         1 
                   bladel                 bladaelet                   badelet 
                        1                         1                         1 
                     bade 
                        1 
# BM: this is an unusual coding pattern, I'm curious about where you got it from?

tl3 <- tl3 %>%
  mutate(
    Blank2 = case_when(
      Blank2 == "flake" ~ "flake",  # Keep "flake" as it is
      (`Core Typology` %in% c("0", "NA", "na", "-", ".") | 
       is.na(`Core Typology`) | 
       `Core Typology` == "") & `Width (mm)` < 12 ~ "bladelet",
      (`Core Typology` %in% c("0", "NA", "na", "-", ".") | 
       is.na(`Core Typology`) | 
       `Core Typology` == "") & `Width (mm)` >= 12 ~ "blade",
      TRUE ~ Blank2
    )
  )  %>%
  mutate(
    Blank2 = case_when(
      Blank2 %in% c("blade", "bladelet", "flake") ~ Blank2,
      TRUE ~ NA_character_
    )
  )
# Remove rows based on row names
# tl3 <- tl3[!(rownames(tl3) %in% c("1030", "644", "543")), ]

# BM: why are we removing these rows? A comment here would be good to explain. A simpler way, by referencing the row numbers directly:
# SS: they are natural rocks, and don't want to count them as lithic

tl3 <- tl3[-c(1030, 644, 543), ]
tl4 <- tl3 %>%
  mutate(
    Utilization = if_else(Retouch == "1", 
                          NA_character_, 
                          as.character(Utilization))
  )
tl4 <- tl4 %>%
  # BM: the problem with this combination of mutate_all and ifelse that you use below is that they 
  # coerce all columns to be the same data type, so you'll see that all the numeric
  # columns are now character columns after you run these lines. So you need to
  # coerce those number columns back to numeric type so you can plot and compute
  # with them
  mutate_all(~ ifelse(is.na(.x) | .x == "", NA, .x)) %>% 
  # BM: what does this next line do?
  #SS: I wanted to remove any asterisks, whitespace, or *, ?, or !. is that wrong?
  
  mutate_all(~ str_replace(., "(?<=\\D)\\*(?=\\D)|\\s+|[*?!]+", "")) %>%
  # BM: what is this SHINE variable? I'm not familiar with it
  
  ##SS: we meant sickle shine, this is one of the criteria based on which Hole claimed the site is not related to agriculture (similar to ALi Kosh located in Dehluran)
  mutate(
    SHINE = str_trim(SHINE) %>% 
            str_to_title(),
    shine2 = SHINE
  ) %>%
  mutate(
    shine2 = case_when(
      SHINE %in% c("Subparallel", 
                   "Parallel", 
                   "Sub-Parallel", 
                   "Parallel-Subprarallel",
                   "Scaled", 
                   "Sub-Paralel", 
                   "Sub-Parallell", 
                   "Sub-Paallel",
                   "Sub-Paralell", 
                   "Sub-Prallel", 
                   "L:semiparallel/R:scaled",
                   "Semiparallel", 
                   "Semi-Parallel", 
                   "Scaled/Sub-Parallel",
                   "Seb-Parallel", 
                   "Semi-Abrupt") ~ NA_character_,
      TRUE ~ SHINE
    ),
    Utilization = if_else(Utilization == "0", NA_character_, Utilization),
    Retouch =     if_else(Retouch == "0", NA_character_, Retouch),
    SHINE =       if_else(SHINE == "0", NA_character_, SHINE),
    shine2 =      if_else(shine2 == "0", NA_character_, shine2),
    Blank2 =      if_else(Blank2 == "0", NA_character_, Blank2)
  ) %>% 
  mutate(
    SHINE = na_if(SHINE, "")
  )


# BM: I think this is a better way to inspect:
rev(sort(table(tl4$SHINE)))

            Sub-Parallel                        1              Subparallel 
                     200                       56                       22 
                  Scaled                 Parallel              Sub-Paralel 
                      22                        9                        6 
           Semi-Parallel              Sub-Prallel             Semiparallel 
                       5                        4                        2 
           Sub-Parallell             Sub-Paralell              Sub-Paallel 
                       1                        1                        1 
             Semi-Abrupt             Seb-Parallel      Scaled/Sub-Parallel 
                       1                        1                        1 
   Parallel-Subprarallel L:semiparallel/R: Scaled 
                       1                        1 
rev(sort(table(tl4$shine2)))

                       1 L:semiparallel/R: Scaled                          
                      56                        1                        1 
# Convert 'NA' and 'na' strings to actual NA
tl4$`Core Typology` <- na_if(tl4$`Core Typology`, "NA")
tl4$`Core Typology` <- na_if(tl4$`Core Typology`, "na")

tl4 <- tl4 %>%
  mutate(
    `Core Typology` = str_to_lower(`Core Typology`),
    `Core Typology` = str_trim(`Core Typology`),
    # BM: what does this regex do in the next line?
    `Core Typology` = str_replace_all(`Core Typology`, "^[-._/NA\\s]*$|^\\s*$", "0")
  ) %>%
  mutate(`Core Typology` = case_when(
    `Core Typology` == "flatcore" ~ "flat-pressure",
             `Core Typology` == "rejuvention" ~ "rejuvenation piece-NA",
             `Core Typology` == "pressureprymidal core" ~ "pyramid-pressure",
             `Core Typology` == "pressureflat core" ~ "flat-pressure",
             `Core Typology` == "pressurebullet core" ~ "bullet-pressure",
             `Core Typology` == "prussurebullet core" ~ "bullet-pressure",
             `Core Typology` == "prismaticcore" ~ "prismatic-percussion",
             `Core Typology` == "pyramidalpressure core" ~ "pyramid-pressure",
             `Core Typology` == "flatcore with one debitage surface/pressure" ~ "flat-pressure",
             `Core Typology` == "corefragment" ~ "core fragment-NA",
             `Core Typology` == "cilandrical/pressure" ~ "cylinder-pressure",
             `Core Typology` == "bullet/pressure" ~ "bullet-pressure",
             `Core Typology` == "pyramidal/pressure" ~ "pyramid-pressure",
             `Core Typology` == "percussion/pyramidal" ~ "pyramid-pressure",
             `Core Typology` == "flat/pressure" ~ "flat-pressure",
             `Core Typology` == "pyramidal/ percussion??" ~ "pyramid-pressure",
             `Core Typology` == "pyramidal/ peressure" ~ "pyramid-pressure",
             `Core Typology` == "pyramidal/ pressure" ~ "pyramid-pressure",
             `Core Typology` == "pressure" ~ "pyramid-pressure",
             `Core Typology` == "multidirectional/percussion" ~ "shapeless-percussion",
             `Core Typology` == "prismatic/ percussion" ~ "pyramid-pressure",
             `Core Typology` == "flatcore/ unidirectional/pressure" ~ "flat-pressure",
             `Core Typology` == "heavilyused" ~ "NA",
             `Core Typology` == "burnt" ~ "NA",
             `Core Typology` == "patinated" ~ "NA",
             `Core Typology` == "pyramidal(bullet)/pressure" ~ "bullet-pressure",
             `Core Typology` == "cylandrycal/ bidirectional pressure core" ~ "bullet-pressure",
             `Core Typology` == "pyramidal/unidirectional pressure bullet core" ~ "bullet-pressure",
             `Core Typology` == "pyramidal/unidirectional pressure  core" ~ "pyramid-pressure",
             `Core Typology` == "pyramidal/unidirectional pressure  core" ~ "pyramid-pressure",
             `Core Typology` == "bladelet" ~ "bullet-pressure",
             `Core Typology` == "lip" ~ "NA",
             `Core Typology` == "bladlet" ~ "bullet-pressure",
             `Core Typology` == "bladelet(30.56)" ~ "pyramid-pressure",
             `Core Typology` == "bladelet(28.55.6)" ~ "bullet-pressure",
             `Core Typology` == "bladelet(16.28.1)" ~ "bullet-pressure",
             `Core Typology` == "bladelet(40 5.7)" ~ "pyramid-pressure",
             `Core Typology` == "bladelet(23.2 2.3)" ~ "bullet-pressure",
             `Core Typology` == "bladelet-flakeblade(41 16)" ~ "bullet-pressure",
             `Core Typology` == "bladelet(28 6.7)" ~ "bullet-pressure",
             `Core Typology` == "bladelet(28 6.7)" ~ "bullet-pressure",
             `Core Typology` == "bladelet(3512.6/7)" ~ "pyramid-pressure",
             `Core Typology` == "bladelet(27.307.5)" ~ "bullet-pressure",
    `Core Typology` == "pressure/pyramidal" ~ "pyramid-pressure",
    `Core Typology` == "bladeletcore" ~ "bullet-pressure",
    `Core Typology` == "pyramidal? / pressure" ~ "pyramid-pressure",
    `Core Typology` == "prismatic" ~ "pyramid-pressure",
    
    `Core Typology` == "bullet" ~ "bullet-pressure",
    
    TRUE ~ `Core Typology`
  )) %>%
# Separate 'Core Typology' into 'core-typology' and 'core-technology'
  separate(`Core Typology`, 
           into = c("core-typology", "core-technology"),
           sep = "-",
           remove = FALSE,
           convert = TRUE)

# Convert 'NA' and 'na' in new columns to actual NA
tl4$`core-typology` <- na_if(tl4$`core-typology`, "na")
tl4$`core-technology` <- na_if(tl4$`core-technology`, "na")

# Check the unique values again
# BM: still many typos, are they important?
rev(sort(table((tl4$`core-typology`))))

            bullet            pyramid               flat                  0 
                43                 39                  6                  5 
rejuvenation piece          shapeless          prismatic           cylinder 
                 2                  1                  1                  1 
     core fragment 
                 1 
rev(sort(table((tl4$`core-technology`))))

  pressure percussion 
        89          2 
tl4 <- tl4 %>%
  mutate(
    Typology = str_to_lower(Typology),
    Typology = str_trim(Typology),
    Typology = str_replace_all(Typology, "^[-._/NA\\s]*$|^\\s*$", "0")
  ) %>%
  mutate(
    # BM: wow, seems like almost each artefact is its own type! 
    # BM: That is not ideal for statistical analysis
    # BM: This looks like it was very time-consuming to simplify. 
    ##SS: this column was so messy with too many mistakes; I needed to have all typos correct then transfer them in their corresponding columns.  
    Typology = case_when(
      `Typology` == "notch, truncated" ~ "tool/notch;truncated piece",
      `Typology` == "retouchpiece" ~ "tool/retouched piece",
      `Typology` == "endscraper" ~ "tool/end scraper",
      `Typology` == "notch" ~ "tool/notch",
      `Typology` == "sidescraper" ~ "tool/side scraper",
      `Typology` == "doubleside scraper" ~ "tool/double side scraper",
      `Typology` == "convergentscraper (?)" ~ "tool/convergent scraper",
      `Typology` == "doublenotch on retouched piece" ~ "tool/double notch",
      `Typology` == "retouchpieces" ~ "tool/retouched piece",
      `Typology` == "burin(?)/ notch/scraper" ~ "tool/burin-notch-scraper",
      `Typology` == "borer" ~ "tool/perforator-borer",
      `Typology` == "retouchedpiece" ~ "tool/retouched piece",
      `Typology` == "notch/side scraper" ~ "tool/notch-side scraper",
      `Typology` == "corefragment" ~ "core/core fragment",
      `Typology` == "backed" ~ "tool/backed knife",
      `Typology` == "doubleside scraper ?" ~ "tool/double side scraper",
      `Typology` == "inversedenticulate" ~ "tool/denticulate",
      `Typology` == "retouchpieces/ side scraper?" ~ "tool/side scraper",
      `Typology` == "sidescraper ?" ~ "tool/side scraper",
      `Typology` == "notch-denticulate" ~ "tool/notch-denticulate",
      `Typology` == "borer/drill" ~ "tool/perforator-drill",
      `Typology` == "retouchedpiece (side scraper?)" ~ "tool/side scraper",
      `Typology` == "retouchepiece (side scraper?)" ~ "tool/side scraper",
      `Typology` == "retouchedpiece (double side scraper)" ~ "tool/double side scraper",
      `Typology` == "retouchedpiece (double side scraper?)" ~ "tool/double side scraper",
      `Typology` == "retouchepiece" ~ "tool/retouched piece",
      `Typology` == "inversenotch" ~ "tool/notch",
      `Typology` == "retouchepiece (double side scaraper?)" ~ "tool/double side scraper",
      `Typology` == "retouchedpiece( double side scraper?)" ~ "tool/double side scraper",
      `Typology` == "notchon retouche piece" ~ "tool/notch",
      `Typology` == "retouchedpiece (souble side scraper)" ~ "tool/double side scraper",
      `Typology` == "point" ~ "tool/perforator-point",
      `Typology` == "chunk" ~ "NA/NA",
      `Typology` == "coretablet" ~ "core/core tablet",
      `Typology` == "core" ~ "core/shapeless",
      `Typology` == "denticulate" ~ "tool/denticulate",
      `Typology` == "doublenotch (haft)" ~ "tool/double notch",
      `Typology` == "retouchedpiece (fine retouch)" ~ "tool/retouched piece",
      `Typology` == "endscraper on retouched piece" ~ "tool/end scraper",
      `Typology` == "retouchedpiece (serrated scraper)" ~ "tool/serrated scraper",
      `Typology` == "truncation" ~ "tool/truncated piece",
      `Typology` == "rejuventionpiece" ~ "core/rejuvenation piece",
      `Typology` == "notch/denticulate" ~ "tool/notch-denticulate",
      `Typology` == "retoucheduse on breakage" ~ "tool/retouched piece",
      `Typology` == "inversenotch/endscraper" ~ "tool/notch-end scraper",
      `Typology` == "alternatingside scraper" ~ "tool/side scraper",
      `Typology` == "alternatedouble side scraper" ~ "tool/double side scraper",
      `Typology` == "truncation/sidescaraper" ~ "tool/truncated piece",
      `Typology` == "doublenotch" ~ "tool/double notch",
      `Typology` == "borer/awl" ~ "tool/perforator-awl",
      `Typology` == "roundscraper?" ~ "tool/round scraper",
      `Typology` == "doublenotch scraper" ~ "tool/double notch scraper",
      `Typology` == "corerejuvention (core tablet?)" ~ "core/core tablet",
      `Typology` == "truncationاریبب" ~ "tool/truncated piece",
      `Typology` == "retouchedpiece (side scraper)" ~ "tool/side scraper",
      `Typology` == "retochedpice" ~ "tool/retouched piece",
      `Typology` == "truncation/notch" ~ "tool/truncated piece-notch",
      `Typology` == "doublealternate scraper" ~ "tool/double side scraper",
      `Typology` == "awl/ inverse notch" ~ "tool/notch",
      `Typology` == "retouchedpiece (alternate scraper?)" ~ "tool/double side scraper",
      `Typology` == "inverseside scraper" ~ "tool/side scraper",
      `Typology` == "usedcore rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "coreside rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "coreplatform rejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "corerejuvention platform" ~ "core/rejuvenation piece",
      `Typology` == "coreside rejuvention blade" ~ "core/rejuvenation piece",
      `Typology` == "coreside rejuvention blade??" ~ "core/rejuvenation piece",
      `Typology` == "coreedge rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "coreedge rejivention" ~ "core/rejuvenation piece",
      `Typology` == "retouchedpice (side scraper?)" ~ "tool/side scraper" ,
      `Typology` == "scraper" ~ "tool/side scraper",
      `Typology` == "sickleblade" ~ "tool/sickle shine",
      `Typology` == "coretool (scraper)" ~ "tool/scraper-on core piece",
      `Typology` == "retouchedpiece (scraper)" ~ "tool/side scraper",
      `Typology` == "inversedenticulate?" ~ "tool/denticulate",
      `Typology` == "retouchedpiece (scraper?)" ~ "tool/side scraper",
      `Typology` == "coreside rejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "truncation/endscraper" ~ "tool/endscraper on truncated piece",
      `Typology` == "retouchedpice(double side scraper?)" ~ "tool/double side scraper",
      `Typology` == "doublescraper" ~ "tool/double side scraper",
      `Typology` == "dendiculate" ~ "tool/denticulate",
      `Typology` == "double-scraper" ~ "tool/double side scraper",
      `Typology` == "pyramidalcore" ~ "core/pyramid",
      `Typology` == "bulletcore" ~ "core/bullet",
      `Typology` == "corerejuvention" ~ "core/rejuvenation piece",
      `Typology` == "pyrmidalcore" ~ "core/pyramid",
      `Typology` == "corepreperation" ~ "core/core preparation piece",
      `Typology` == "crested" ~ "core/crested bladelet",
      `Typology` == "preperationblade" ~ "core/core preperation",
      `Typology` == "burin" ~ "tool/burin",
      `Typology` == "serrateddenticulate" ~ "tool/serrated scraper",
      `Typology` == "saw:serrated denticulate" ~ "tool/serrated scraper",
      `Typology` == "serratedused" ~ "tool/serrated scraper",
      `Typology` == "corepreeration" ~ "tool/core preparation piece",
      `Typology` == "coreprepearation" ~ "tool/core preparation piece",
      `Typology` == "awl" ~ "tool/perforator-awl",
      `Typology` == "notch.inverse" ~ "tool/notch",
      `Typology` == "point.notch" ~ "tool/perforator-point;notch",
      `Typology` == "inversescraper" ~ "tool/side scraper",
      `Typology` == "roundendscraper" ~ "tool/round scraper",
      `Typology` == "alternate.scraper" ~ "tool/double side scraper",
      `Typology` == "convergentscraper/disc scraper" ~ "tool/scraper-convergent scraper",
      `Typology` == "serratedside scraper" ~ "tool/serrated scraper",
      `Typology` == "debri" ~ "NA/NA",
      `Typology` == "distalpart of a drill" ~ "tool/perforator-drill",
      `Typology` == "corepreperation?" ~ "core/core preparation piece",
      `Typology` == "preformend of a borer" ~ "tool/perforator-borer; preform",
      `Typology` == "used" ~ "tool/used",
      `Typology` == "distalend of a inverse sidescraper" ~ "tool/side scraper",
      `Typology` == "retouchedblade" ~ "tool/retouched piece",
      `Typology` == "drill" ~ "tool/perforator-drill",
      `Typology` == "corerejuvention tablet" ~ "core/core tablet",
      `Typology` == "bladeletcore" ~ "core/pyramid",
      `Typology` == "flake-bladecore" ~ "core/mixed",
      `Typology` == "notch, truncated" ~ "tool/notch;truncated piece",
      `Typology` == "retouchpiece" ~ "tool/retouched piece",
      `Typology` == "endscraper" ~ "tool/end scraper",
      `Typology` == "notch" ~ "tool/notch",
      `Typology` == "sidescraper" ~ "tool/side scraper",
      `Typology` == "doubleside scraper" ~ "tool/double side scraper",
      `Typology` == "convergentscraper (?)" ~ "tool/convergent scraper",
      `Typology` == "doublenotch on retouched piece" ~ "tool/double notch",
      `Typology` == "retouchpieces" ~ "tool/retouched piece",
      `Typology` == "burin(?)/ notch/scraper" ~ "tool/burin-notch-scraper",
      `Typology` == "borer" ~ "tool/perforator-borer",
      `Typology` == "retouchedpiece" ~ "tool/retouched piece",
      `Typology` == "notch/side scraper" ~ "tool/notch-side scraper",
      `Typology` == "corefragment" ~ "core/core fragment",
      `Typology` == "backed" ~ "tool/backed knife",
      `Typology` == "doubleside scraper ?" ~ "tool/double side scraper",
      `Typology` == "inversedenticulate" ~ "tool/denticulate",
      `Typology` == "retouchpieces/ side scraper?" ~ "tool/side scraper",
      `Typology` == "sidescraper ?" ~ "tool/side scraper",
      `Typology` == "notch-denticulate" ~ "tool/notch-denticulate",
      `Typology` == "borer/drill" ~ "tool/perforator-drill",
      `Typology` == "retouchedpiece (side scraper?)" ~ "tool/side scraper",
      `Typology` == "retouchepiece (side scraper?)" ~ "tool/side scraper",
      `Typology` == "retouchedpiece (double side scraper)" ~ "tool/double side scraper",
      `Typology` == "retouchedpiece (double side scraper?)" ~ "tool/double side scraper",
      `Typology` == "retouchepiece" ~ "tool/retouched piece",
      `Typology` == "inversenotch" ~ "tool/notch",
      `Typology` == "retouchepiece (double side scaraper?)" ~ "tool/double side scraper",
      `Typology` == "retouchedpiece( double side scraper?)" ~ "tool/double side scraper",
      `Typology` == "notchon retouche piece" ~ "tool/notch",
      `Typology` == "retouchedpiece (souble side scraper)" ~ "tool/double side scraper",
      `Typology` == "point" ~ "tool/perforator-point",
      `Typology` == "chunk" ~ "NA/NA",
      `Typology` == "coretablet" ~ "core/core tablet",
      `Typology` == "core" ~ "core/shapeless",
      `Typology` == "denticulate" ~ "tool/denticulate",
      `Typology` == "doublenotch (haft)" ~ "tool/double notch",
      `Typology` == "retouchedpiece (fine retouch)" ~ "tool/retouched piece",
      `Typology` == "endscraper on retouched piece" ~ "tool/end scraper",
      `Typology` == "retouchedpiece (serrated scraper)" ~ "tool/serrated scraper",
      `Typology` == "truncation" ~ "tool/truncated piece",
      `Typology` == "rejuventionpiece" ~ "core/rejuvenation piece",
      `Typology` == "notch/denticulate" ~ "tool/notch-denticulate",
      `Typology` == "retoucheduse on breakage" ~ "tool/retouched piece",
      `Typology` == "inversenotch/endscraper" ~ "tool/notch-end scraper",
      `Typology` == "alternatingside scraper" ~ "tool/side scraper",
      `Typology` == "alternatedouble side scraper" ~ "tool/double side scraper",
      `Typology` == "truncation/sidescaraper" ~ "tool/truncated piece",
      `Typology` == "doublenotch" ~ "tool/double notch",
      `Typology` == "borer/awl" ~ "tool/perforator-awl",
      `Typology` == "roundscraper?" ~ "tool/round scraper",
      `Typology` == "doublenotch scraper" ~ "tool/double notch scraper",
      `Typology` == "corerejuvention (core tablet?)" ~ "core/core tablet",
      `Typology` == "truncationاریبب" ~ "tool/truncated piece",
      `Typology` == "retouchedpiece (side scraper)" ~ "tool/side scraper",
      `Typology` == "retochedpice" ~ "tool/retouched piece",
      `Typology` == "truncation/notch" ~ "tool/truncated piece-notch",
      `Typology` == "doublealternate scraper" ~ "tool/double side scraper",
      `Typology` == "awl/ inverse notch" ~ "tool/notch",
      `Typology` == "retouchedpiece (alternate scraper?)" ~ "tool/double side scraper",
      `Typology` == "inverseside scraper" ~ "tool/side scraper",
      `Typology` == "usedcore rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "coreside rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "coreplatform rejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "corerejuvention platform" ~ "core/rejuvenation piece",
      `Typology` == "coreside rejuvention blade" ~ "core/rejuvenation piece",
      `Typology` == "coreside rejuvention blade??" ~ "core/rejuvenation piece",
      `Typology` == "coreedge rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "coreedge rejivention" ~ "core/rejuvenation piece",
      `Typology` == "retouchedpice (side scraper?)" ~ "tool/side scraper" ,
      `Typology` == "scraper" ~ "tool/side scraper",
      `Typology` == "sickleblade" ~ "tool/sickle shine",
      `Typology` == "coretool (scraper)" ~ "tool/scraper-on core piece",
      `Typology` == "retouchedpiece (scraper)" ~ "tool/side scraper",
      `Typology` == "inversedenticulate?" ~ "tool/denticulate",
      `Typology` == "retouchedpiece (scraper?)" ~ "tool/side scraper",
      `Typology` == "coreside rejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "truncation/endscraper" ~ "tool/endscraper on truncated piece",
      `Typology` == "retouchedpice(double side scraper?)" ~ "tool/double side scraper",
      `Typology` == "doublescraper" ~ "tool/double side scraper",
      `Typology` == "dendiculate" ~ "tool/denticulate",
      `Typology` == "double-scraper" ~ "tool/double side scraper",
      `Typology` == "pyramidalcore" ~ "core/pyramid",
      `Typology` == "bulletcore" ~ "core/bullet",
      `Typology` == "corerejuvention" ~ "core/rejuvenation piece",
      `Typology` == "pyrmidalcore" ~ "core/pyramid",
      `Typology` == "corepreperation" ~ "core/core preparation piece",
      `Typology` == "crested" ~ "core/crested bladelet",
      `Typology` == "preperationblade" ~ "core/core preperation",
      `Typology` == "burin" ~ "tool/burin",
      `Typology` == "serrateddenticulate" ~ "tool/serrated scraper",
      `Typology` == "saw:serrated denticulate" ~ "tool/serrated scraper",
      `Typology` == "serratedused" ~ "tool/serrated scraper",
      `Typology` == "corepreeration" ~ "tool/core preparation piece",
      `Typology` == "coreprepearation" ~ "tool/core preparation piece",
      `Typology` == "awl" ~ "tool/perforator-awl",
      `Typology` == "notch.inverse" ~ "tool/notch",
      `Typology` == "point.notch" ~ "tool/perforator-point;notch",
      `Typology` == "inversescraper" ~ "tool/side scraper",
      `Typology` == "roundendscraper" ~ "tool/round scraper",
      `Typology` == "alternate.scraper" ~ "tool/double side scraper",
      `Typology` == "convergentscraper/disc scraper" ~ "tool/scraper-convergent scraper",
      `Typology` == "serratedside scraper" ~ "tool/serrated scraper",
      `Typology` == "debri" ~ "NA/NA",
      `Typology` == "distalpart of a drill" ~ "tool/perforator-drill",
      `Typology` == "corepreperation?" ~ "core/core preparation piece",
      `Typology` == "preformend of a borer" ~ "tool/perforator-borer; preform",
      `Typology` == "used" ~ "tool/used",
      `Typology` == "distalend of a inverse sidescraper" ~ "tool/side scraper",
      `Typology` == "retouchedblade" ~ "tool/retouched piece",
      `Typology` == "drill" ~ "tool/perforator-drill",
      `Typology` == "corerejuvention tablet" ~ "core/core tablet",
      `Typology` == "bladeletcore" ~ "core/pyramid",
      `Typology` == "flake-bladecore" ~ "core/mixed",
      `Typology` == "bladelet-corerejuvention" ~ "core/rejuvenation piece",
      `Typology` == "bladelet-corefragment" ~ "core/core fragment",
      `Typology` == "pointedused" ~ "tool/perforator-point",
      `Typology` == "microburin" ~ "tool/microburin",
      `Typology` == "bladeletcore fragment" ~ "core/core fragment",
      `Typology` == "rejuventionface flake" ~ "core/rejuvenation piece",
      `Typology` == "corepreperation flake" ~ "core/core preparation piece",
      `Typology` == "corerejuvention flake"  ~ "core/rejuvenation piece",
      `Typology` == "unfinished  pyramid core" ~ "core/pyramid",
      `Typology` == "bladeletcoretablet" ~ "core/core tablet",
      `Typology` == "bladeletcore rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "debitage" ~ "NA/NA",
      `Typology` == "bladeletcore  rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "inverseserrated scraper" ~ "tool/serrated scraper",
      `Typology` == "backedknife" ~ "tool/backed knife",
      `Typology` == "corepreparation" ~ "core/core preparation piece",
      `Typology` == "primaryflake" ~ "core/primary flake",
      `Typology` == "pointedconvergent scraper on bladelet" ~ "tool/perforator-point",
      `Typology` == "trie" ~ "NA/NA",
      `Typology` == "part of core tablet" ~ "core/core tablet",
      `Typology` == "zaviedar" ~ "NA/NA",
      `Typology` == "convergentscraper" ~ "tool/convergent scraper",
      `Typology` == "preparationflake" ~ "core/core preparation piece",
      `Typology` == "atypicalborer" ~ "tool/perforator-borer",
      `Typology` == "naturalybacked knife" ~ "tool/backed knife-naturally backed knife",
      `Typology` == "pyramidbladelet core" ~ "core/pyramid",
      `Typology` == "flatbladelet core" ~ "core/flat",
      `Typology` == "bladecore" ~ "core/pyramid",
      `Typology` == "bulletbladelet core" ~ "core/bullet",
      `Typology` == "coerejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "finishedbladelet core" ~ "core/bullet",
      `Typology` == "failed pyramid core?" ~ "core/pyramid",
      `Typology` == "pyramidplain bladelet core" ~ "core/pyramid",
      `Typology` == "coeon flake" ~ "core/core on flake",
      `Typology` == "coeejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "bladeletcoe rejuvention tablet?" ~ "core/core tablet",
      `Typology` == "pyramidcore" ~ "core/pyramid",
      `Typology` == "bladeletcore tablet" ~ "core/core tablet",
      `Typology` == "pyramidbladeleet core" ~ "core/pyramid",
      `Typology` == "flake" ~ "NA/NA",
      `Typology` == "serrated" ~ "tool/serrated scraper",
      `Typology` == "curvedretouched piece" ~ "tool/retouched piece",
      `Typology` == "pyramidalbladelet core" ~ "core/pyramid",
      `Typology` == "multidirectionalcore fragment" ~ "core/multidirectional core fragment",
      `Typology` == "unidirectionalblade? core fragent" ~ "core/pyramid",
      `Typology` == "backed/corerejuvention" ~ "tool/backed knife",
      `Typology` == "unidirectionalbladelet core" ~ "core/pyramid",
      `Typology` == "unifacialbalde core fragment?" ~ "core/pyramid",
      `Typology` == "flakedetached from a bladelet core" ~ "core/core preparation piece",
      `Typology` == "corepreparation tablet" ~ "core/core tablet",
      `Typology` == "bladeletcore fragent" ~ "core/core fragment-pyramid",
      `Typology` == "alternatescraper??" ~ "tool/double side scraper",
      `Typology` == "endscraper.onrejuvention" ~ "core/rejuvenation piece",
      `Typology` == "inverseserrated" ~ "tool/serrated scraper",
      `Typology` == "patination.omitted" ~ "NA/NA",
      `Typology` == "trapze" ~ "tool/geometric-triangle",
      `Typology` == "trapzoid" ~ "tool/geometric-triangle",
      `Typology` == "borer.drill" ~ "tool/perforator-drill",
      `Typology` == "serraed" ~ "tool/serrated scraper",
      `Typology` == "bladeletcore on a flake" ~ "core/core on flake",
      `Typology` == "geofact" ~ "NA/NA",
      `Typology` == "denticulateborer?" ~ "tool/perforator-borer;denticulate",
      `Typology` == "sideborer-denticulate" ~ "tool/perforator-borer;denticulate",
      `Typology` == "borer.awl" ~ "tool/perforator-awl",
      `Typology` == "roundscraper" ~ "tool/round scraper",
      `Typology` == "truncationon a bladelet core" ~ "tool/truncated piece",
      `Typology` == "truncation.notch" ~ "tool/truncated piece;notch",
      `Typology` == "backed-denticulate" ~ "tool/backed;denticulate",
      `Typology` == "brokendrill" ~ "tool/perforator-drill",
      `Typology` == "drillbroken" ~ "tool/perforator-drill",
      `Typology` == "point/broken drill" ~ "tool/perforator-point",
      `Typology` == "brokendrill?" ~ "tool/perforator-drill",
      `Typology` == "partialyserrated" ~ "tool/serrated scraper",
      `Typology` == "naturallybacked" ~ "tool/backed knife-naturally backed knife",
      `Typology` == "transversescraper" ~ "tool/transverse scraper",
      `Typology` == "naturalybacked" ~ "tool/backed knife-naturally backed knife",
      `Typology` == "awl-notch" ~ "tool/perforator-awl",
      `Typology` == "psedulevalois" ~ "tool/psedulevalois flake",
      `Typology` == "alternatingdenticulate" ~ "tool/denticulate",
      `Typology` == "usedcore fragment" ~ "tool/core tool-used core fragment",
      `Typology` == "multidirectionalmicroflake core" ~ "core/multidirectional flake core",
      `Typology` == "mixedpyramidal core" ~ "core/pyramid",
      `Typology` == "usedbladecore fragment" ~ "tool/core tool-used core fragment",
      `Typology` == "multidirectionalbladelet core fragment" ~ "core/multidirectional bladelet core",
      `Typology` == "unidirectionalbladelet core.cylinder" ~ "core/prismatic",
      `Typology` == "pyrymedalmixed core" ~ "core/pyramid",
      `Typology` == "pyramedial/bullet core" ~ "core/bullet",
      `Typology` == "corefragent" ~ "core/core fragment",
      `Typology` == "pyramedialbladelet core fragment" ~ "core/pyramid",
      `Typology` == "unidirectionalbladelet core fragment" ~ "core/pyramid",
      `Typology` == "unifacialunidirectional bladelet core" ~ "core/pyramid",
      `Typology` == "unidirectionalblade core" ~ "core/pyramid",
      `Typology` == "pyramidalbladelet core fragment" ~ "core/pyramid",
      `Typology` == "corerejuvention?" ~ "core/rejuvenation piece",
      `Typology` == "flatburin? point?" ~ "tool/flat burin",
      `Typology` == "primaryblade" ~ "core/primary blade",
      `Typology` == "trihedralgeometric" ~ "tool/geometric-triangle",
      `Typology` == "lunate" ~ "tool/geometric-lunate",
      `Typology` == "corepaltform rejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "pressurebladelet core /semi flat" ~ "core/pyramid",
      `Typology` == "failedpercussion blade core/semi pyramedal" ~ "core/pyramid",
      `Typology` == "percussionbladelet core/unidirectional" ~ "core/pyramid-percussion",
      `Typology` == "percussion.unidirectional.blade-flakecore" ~ "core/mixed-percussion",
      `Typology` == "obliqueretouched bladelet" ~ "tool/retouched piece",
      `Typology` == "percussionunidirectional pyramidal  bladelet core" ~ "core/pyramid",
      `Typology` == "lunategeometric" ~ "tool/geometric-lunate",
      `Typology` == "awl on a core rejuvention" ~ "tool/perforator-awl on core rejuvenation piece",
      `Typology` == "truncated" ~ "tool/truncated piece",
      `Typology` == "multiplenotch" ~ "tool/notch",
      `Typology` == "dishedconvergent bladelet" ~ "tool/convergent scraper",
      `Typology` == "bipolarpercussion blade-bladelet core" ~ "core/bipolar-percussion",
      `Typology` == "bladeletbullet core" ~ "core/bullet",
      `Typology` == "alternatingserrated" ~ "tool/serrated scraper",
      `Typology` == "shaplesscore" ~ "core/shapeless",
      `Typology` == "corepreparation?" ~ "core/core preparation piece",
      `Typology` == "obliqueretouched" ~ "tool/retouched piece",
      `Typology` == "corepreparation flake" ~ "core/core preparation piece",
      `Typology` == "backeddenticulate" ~ "tool/backed;denticulate",
      `Typology` == "awlnotch" ~ "tool/perforator-awl;notch",
      `Typology` == "scraperburin?" ~ "tool/burin;scraper",
      `Typology` == "notchround scraper" ~ "tool/round scraper;notch",
      `Typology` == "corerejuvention tablet round scraper" ~ "tool/round scraper on core tablet",
      `Typology` == "alternatescraper" ~ "tool/double side scraper",
      `Typology` == "coreplatform preperation flake" ~ "core/rejuvenation piece",
      `Typology` == "coreplatform rejuvention tablet" ~ "core/core tablet",
      `Typology` == "brokenpyramidal core bladelet" ~ "core/pyramid",
      `Typology` == "pyramidalbladelet core/semi bullet?" ~ "core/bullet",
      `Typology` == "coreside rejuvention flake?" ~ "core/rejuvenation piece-side",
      `Typology` == "unidirectionalpressure bladelet core/unifacila" ~ "core/pyramid",
      `Typology` == "coreplatform rejuvention tablet/or multidirectional core" ~ "core/rejuvenation piece",
      `Typology` == "bulletbladlet core" ~ "core/bullet",
      `Typology` == "cylinderbipolar bladelet core" ~ "core/prismatic",
      `Typology` == "backedknife/core platform rejuvenation" ~ "tool/backed knife",
      `Typology` == "flatunifacial bladelet core" ~ "core/flat",
      `Typology` == "coreprepration flake" ~ "core/core preparation piece",
      `Typology` == "coreplatform preperation" ~ "core/core preparation piece-platform",
      `Typology` == "borerpreform" ~ "tool/perforator-borer",
      `Typology` == "rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "borerpreform?" ~ "tool/perforator-borer",
      `Typology` == "inversnotch" ~ "tool/notch",
      `Typology` == "alternateconvergent" ~ "tool/convergent scraper",
      `Typology` == "unidirectionalbladelet/flake-blade core" ~ "core/mixed",
      `Typology` == "unidirectionalmixed core" ~ "core/mixed",
      `Typology` == "unidirectionalflat bladelet core" ~ "core/flat",
      `Typology` == "" ~ "NA-NA",
      `Typology` == "na" ~ "NA-NA",
      `Typology` == "bladelet-corerejuvention" ~ "core/rejuvenation piece",
      `Typology` == "bladelet-corefragment" ~ "core/core fragment",
      `Typology` == "pointedused" ~ "tool/perforator-point",
      `Typology` == "microburin" ~ "tool/microburin",
      `Typology` == "bladeletcore fragment" ~ "core/core fragment",
      `Typology` == "rejuventionface flake" ~ "core/rejuvenation piece",
      `Typology` == "corepreperation flake" ~ "core/core preparation piece",
      `Typology` == "corerejuvention flake"  ~ "core/rejuvenation piece",
      `Typology` == "unfinished  pyramid core" ~ "core/pyramid",
      `Typology` == "bladeletcoretablet" ~ "core/core tablet",
      `Typology` == "bladeletcore rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "debitage" ~ "NA/NA",
      `Typology` == "bladeletcore  rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "inverseserrated scraper" ~ "tool/serrated scraper",
      `Typology` == "backedknife" ~ "tool/backed knife",
      `Typology` == "corepreparation" ~ "core/core preparation piece",
      `Typology` == "primaryflake" ~ "core/primary flake",
      `Typology` == "pointedconvergent scraper on bladelet" ~ "tool/perforator-point",
      `Typology` == "trie" ~ "NA/NA",
      `Typology` == "part of core tablet" ~ "core/core tablet",
      `Typology` == "zaviedar" ~ "NA/NA",
      `Typology` == "convergentscraper" ~ "tool/convergent scraper",
      `Typology` == "preparationflake" ~ "core/core preparation piece",
      `Typology` == "atypicalborer" ~ "tool/perforator-borer",
      `Typology` == "naturalybacked knife" ~ "tool/backed knife-naturally backed knife",
      `Typology` == "pyramidbladelet core" ~ "core/pyramid",
      `Typology` == "flatbladelet core" ~ "core/flat",
      `Typology` == "bladecore" ~ "core/pyramid",
      `Typology` == "bulletbladelet core" ~ "core/bullet",
      `Typology` == "coerejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "finishedbladelet core" ~ "core/bullet",
      `Typology` == "failed pyramid core?" ~ "core/pyramid",
      `Typology` == "pyramidplain bladelet core" ~ "core/pyramid",
      `Typology` == "coeon flake" ~ "core/core on flake",
      `Typology` == "coeejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "bladeletcoe rejuvention tablet?" ~ "core/core tablet",
      `Typology` == "pyramidcore" ~ "core/pyramid",
      `Typology` == "bladeletcore tablet" ~ "core/core tablet",
      `Typology` == "pyramidbladeleet core" ~ "core/pyramid",
      `Typology` == "flake" ~ "NA/NA",
      `Typology` == "serrated" ~ "tool/serrated scraper",
      `Typology` == "curvedretouched piece" ~ "tool/retouched piece",
      `Typology` == "pyramidalbladelet core" ~ "core/pyramid",
      `Typology` == "multidirectionalcore fragment" ~ "core/multidirectional core fragment",
      `Typology` == "unidirectionalblade? core fragent" ~ "core/pyramid",
      `Typology` == "backed/corerejuvention" ~ "tool/backed knife",
      `Typology` == "unidirectionalbladelet core" ~ "core/pyramid",
      `Typology` == "unifacialbalde core fragment?" ~ "core/pyramid",
      `Typology` == "flakedetached from a bladelet core" ~ "core/core preparation piece",
      `Typology` == "corepreparation tablet" ~ "core/core tablet",
      `Typology` == "bladeletcore fragent" ~ "core/core fragment-pyramid",
      `Typology` == "alternatescraper??" ~ "tool/double side scraper",
      `Typology` == "endscraper.onrejuvention" ~ "core/rejuvenation piece",
      `Typology` == "inverseserrated" ~ "tool/serrated scraper",
      `Typology` == "patination.omitted" ~ "NA/NA",
      `Typology` == "trapze" ~ "tool/geometric-triangle",
      `Typology` == "trapzoid" ~ "tool/geometric-triangle",
      `Typology` == "borer.drill" ~ "tool/perforator-drill",
      `Typology` == "serraed" ~ "tool/serrated scraper",
      `Typology` == "bladeletcore on a flake" ~ "core/core on flake",
      `Typology` == "geofact" ~ "NA/NA",
      `Typology` == "denticulateborer?" ~ "tool/perforator-borer;denticulate",
      `Typology` == "sideborer-denticulate" ~ "tool/perforator-borer;denticulate",
      `Typology` == "borer.awl" ~ "tool/perforator-awl",
      `Typology` == "roundscraper" ~ "tool/round scraper",
      `Typology` == "truncationon a bladelet core" ~ "tool/truncated piece",
      `Typology` == "truncation.notch" ~ "tool/truncated piece;notch",
      `Typology` == "backed-denticulate" ~ "tool/backed;denticulate",
      `Typology` == "brokendrill" ~ "tool/perforator-drill",
      `Typology` == "drillbroken" ~ "tool/perforator-drill",
      `Typology` == "point/broken drill" ~ "tool/perforator-point",
      `Typology` == "brokendrill?" ~ "tool/perforator-drill",
      `Typology` == "partialyserrated" ~ "tool/serrated scraper",
      `Typology` == "naturallybacked" ~ "tool/backed knife-naturally backed knife",
      `Typology` == "transversescraper" ~ "tool/transverse scraper",
      `Typology` == "naturalybacked" ~ "tool/backed knife-naturally backed knife",
      `Typology` == "awl-notch" ~ "tool/perforator-awl",
      `Typology` == "psedulevalois" ~ "tool/psedulevalois flake",
      `Typology` == "alternatingdenticulate" ~ "tool/denticulate",
      `Typology` == "usedcore fragment" ~ "tool/core tool-used core fragment",
      `Typology` == "multidirectionalmicroflake core" ~ "core/multidirectional flake core",
      `Typology` == "mixedpyramidal core" ~ "core/pyramid",
      `Typology` == "usedbladecore fragment" ~ "tool/core tool-used core fragment",
      `Typology` == "multidirectionalbladelet core fragment" ~ "core/multidirectional bladelet core",
      `Typology` == "unidirectionalbladelet core.cylinder" ~ "core/prismatic",
      `Typology` == "pyrymedalmixed core" ~ "core/pyramid",
      `Typology` == "pyramedial/bullet core" ~ "core/bullet",
      `Typology` == "corefragent" ~ "core/core fragment",
      `Typology` == "pyramedialbladelet core fragment" ~ "core/pyramid",
      `Typology` == "unidirectionalbladelet core fragment" ~ "core/pyramid",
      `Typology` == "unifacialunidirectional bladelet core" ~ "core/pyramid",
      `Typology` == "unidirectionalblade core" ~ "core/pyramid",
      `Typology` == "pyramidalbladelet core fragment" ~ "core/pyramid",
      `Typology` == "corerejuvention?" ~ "core/rejuvenation piece",
      `Typology` == "flatburin? point?" ~ "tool/flat burin",
      `Typology` == "primaryblade" ~ "core/primary blade",
      `Typology` == "trihedralgeometric" ~ "tool/geometric-triangle",
      `Typology` == "lunate" ~ "tool/geometric-lunate",
      `Typology` == "corepaltform rejuvention flake" ~ "core/rejuvenation piece",
      `Typology` == "pressurebladelet core /semi flat" ~ "core/pyramid",
      `Typology` == "failedpercussion blade core/semi pyramedal" ~ "core/pyramid",
      `Typology` == "percussionbladelet core/unidirectional" ~ "core/pyramid-percussion",
      `Typology` == "percussion.unidirectional.blade-flakecore" ~ "core/mixed-percussion",
      `Typology` == "obliqueretouched bladelet" ~ "tool/retouched piece",
      `Typology` == "percussionunidirectional pyramidal  bladelet core" ~ "core/pyramid",
      `Typology` == "lunategeometric" ~ "tool/geometric-lunate",
      `Typology` == "awl on a core rejuvention" ~ "tool/perforator-awl on core rejuvenation piece",
      `Typology` == "truncated" ~ "tool/truncated piece",
      `Typology` == "multiplenotch" ~ "tool/notch",
      `Typology` == "dishedconvergent bladelet" ~ "tool/convergent scraper",
      `Typology` == "bipolarpercussion blade-bladelet core" ~ "core/bipolar-percussion",
      `Typology` == "bladeletbullet core" ~ "core/bullet",
      `Typology` == "alternatingserrated" ~ "tool/serrated scraper",
      `Typology` == "shaplesscore" ~ "core/shapeless",
      `Typology` == "corepreparation?" ~ "core/core preparation piece",
      `Typology` == "obliqueretouched" ~ "tool/retouched piece",
      `Typology` == "corepreparation flake" ~ "core/core preparation piece",
      `Typology` == "backeddenticulate" ~ "tool/backed;denticulate",
      `Typology` == "awlnotch" ~ "tool/perforator-awl;notch",
      `Typology` == "scraperburin?" ~ "tool/burin;scraper",
      `Typology` == "notchround scraper" ~ "tool/round scraper;notch",
      `Typology` == "corerejuvention tablet round scraper" ~ "tool/round scraper on core tablet",
      `Typology` == "alternatescraper" ~ "tool/double side scraper",
      `Typology` == "coreplatform preperation flake" ~ "core/rejuvenation piece",
      `Typology` == "coreplatform rejuvention tablet" ~ "core/core tablet",
      `Typology` == "brokenpyramidal core bladelet" ~ "core/pyramid",
      `Typology` == "pyramidalbladelet core/semi bullet?" ~ "core/bullet",
      `Typology` == "coreside rejuvention flake?" ~ "core/rejuvenation piece-side",
      `Typology` == "unidirectionalpressure bladelet core/unifacila" ~ "core/pyramid",
      `Typology` == "coreplatform rejuvention tablet/or multidirectional core" ~ "core/rejuvenation piece",
      `Typology` == "bulletbladlet core" ~ "core/bullet",
      `Typology` == "cylinderbipolar bladelet core" ~ "core/prismatic",
      `Typology` == "backedknife/core platform rejuvenation" ~ "tool/backed knife",
      `Typology` == "flatunifacial bladelet core" ~ "core/flat",
      `Typology` == "coreprepration flake" ~ "core/core preparation piece",
      `Typology` == "coreplatform preperation" ~ "core/core preparation piece-platform",
      `Typology` == "borerpreform" ~ "tool/perforator-borer",
      `Typology` == "rejuvention" ~ "core/rejuvenation piece",
      `Typology` == "borerpreform?" ~ "tool/perforator-borer",
      `Typology` == "inversnotch" ~ "tool/notch",
      `Typology` == "alternateconvergent" ~ "tool/convergent scraper",
      `Typology` == "unidirectionalbladelet/flake-blade core" ~ "core/mixed",
      `Typology` == "unidirectionalmixed core" ~ "core/mixed",
      `Typology` == "unidirectionalflat bladelet core" ~ "core/flat",
      `Typology` == "" ~ "NA-NA",
      `Typology` == "na" ~ "NA-NA",
      TRUE ~ `Typology`
    )
  )  %>%
  mutate(
    typology_split = str_split(Typology, "/", simplify = TRUE),
    `typology-tool-core` = typology_split[, 1],
    tool_or_core = ifelse(str_starts(`typology-tool-core`, "tool"), "tool", "core"),
    `tool-typology` = ifelse(tool_or_core == "tool", typology_split[, 2], NA),
    `core-fragment` = ifelse(tool_or_core == "core", typology_split[, 2], NA)
  ) %>%
  # remove temporary columns
  select(-typology_split,-tool_or_core)


# BM: still some typos in there
rev(sort(table((tl4$`tool-typology`))))

                                    notch 
                                       84 
                          retouched piece 
                                       58 
                      double side scraper 
                                       44 
                             side scraper 
                                       41 
                              denticulate 
                                       38 
                         perforator-drill 
                                       19 
                         serrated scraper 
                                       18 
                         perforator-borer 
                                       18 
                              end scraper 
                                       12 
                          truncated piece 
                                       10 
                             backed knife 
                                       10 
                           perforator-awl 
                                        8 
                                    burin 
                                        8 
                             double notch 
                                        7 
                         perforator-point 
                                        6 
                       convergent scraper 
                                        5 
                               microburin 
                                        4 
      backed knife-naturally backed knife 
                                        4 
                                     used 
                                        3 
                            round scraper 
                                        3 
                        notch-denticulate 
                                        3 
                       geometric-triangle 
                                        3 
             perforator-borer;denticulate 
                                        2 
                         geometric-lunate 
                                        2 
             core tool-used core fragment 
                                        2 
                   core preparation piece 
                                        2 
                       backed;denticulate 
                                        2 
                    truncated piece;notch 
                                        1 
                    truncated piece-notch 
                                        1 
                       transverse scraper 
                                        1 
                             sickle shine 
                                        1 
                    scraper-on core piece 
                                        1 
               scraper-convergent scraper 
                                        1 
                      round scraper;notch 
                                        1 
             round scraper on core tablet 
                                        1 
                      psedulevalois flake 
                                        1 
                   perforator-point;notch 
                                        1 
                perforator-borer; preform 
                                        1 
                     perforator-awl;notch 
                                        1 
perforator-awl on core rejuvenation piece 
                                        1 
                    notch;truncated piece 
                                        1 
                       notch-side scraper 
                                        1 
                        notch-end scraper 
                                        1 
                               flat burin 
                                        1 
            endscraper on truncated piece 
                                        1 
                     double notch scraper 
                                        1 
                            burin;scraper 
                                        1 
                      burin-notch-scraper 
                                        1 
rev(sort(table((tl4$`core-fragment`))))

                        pyramid              rejuvenation piece 
                             55                              43 
                      shapeless                                 
                             33                              27 
                    core tablet                              NA 
                             21                              18 
                  core fragment          core preparation piece 
                             15                              14 
                         bullet                            flat 
                             10                               5 
                  primary flake                           mixed 
                              3                               3 
                      prismatic                core preperation 
                              2                               2 
                  core on flake         rejuvenation piece-side 
                              2                               1 
             pyramid-percussion                   primary blade 
                              1                               1 
    multidirectional flake core  multidirectional core fragment 
                              1                               1 
 multidirectional bladelet core                mixed-percussion 
                              1                               1 
               crested bladelet core preparation piece-platform 
                              1                               1 
      core platform rejuvention           core fragment-pyramid 
                              1                               1 
             bipolar-percussion 
                              1 
# Exploring data

tl4 %>% 
  # BM: we need this because of the mutate_all ifelse combo you have above
  mutate(midpoint = parse_number(midpoint)) %>% 
  group_by(midpoint) %>% 
  tally() %>% 
  drop_na(midpoint) %>% 
ggplot() + 
  aes(midpoint, n) +
  geom_col()

# refine the table

tl_final <- tl4 %>%
  rename(
    blank =                Blank2,
   `sickle shine` =       shine2,
    length =              `Length (mm)` ,
    width =               `Width (mm)`,
    thickness =           `Thickness (mm)`, 
    typology =             Typology,
    utilization =          Utilization,
    retouch =              Retouch,
    blank =                Blank2, 
   `blank part` =         `Blank_part`,
   `bulb thickness` =     `Bulb Thickness (mm)`, 
   `platform thickness` = `Platform Thickness (mm)`, 
   `platform length` =    `platform Length (mm)`, 
    eraillure =            Eraillure , 
    cortex =               `Cortex (%)`)  %>%
  mutate(al = paste0(toupper(area), "_", layer)) %>%
  relocate(al, .after = layer)   %>%
  select(lithic_id, 
         TA, 
         area, 
         layer,
         al,
         cortex,
         depth, upper, lower, midpoint, 
        `length`, `width`, `thickness`, 
         typology, 
         utilization, 
        `sickle shine`,
         retouch, 
        `typology-tool-core`,
        `tool-typology`,
         blank, `blank part`, 
        `core-typology`, `core-fragment`,`core-technology`, 
        cortex)  %>% 
# Update the 'typology-tool-core' column based on 'Retouch'
  mutate(
    `typology-tool-core` = case_when(
      retouch == 1 ~ "tool",           
      utilization == 1 ~ "tool",
      `sickle shine` == 1 ~ "tool",
      
      TRUE ~ `typology-tool-core`      
    )
  ) %>% 
  mutate(
    `tool-typology` = case_when(
      utilization == 1 ~ "utilized tool",
      `sickle shine` == 1 ~ "sickle shine",
      TRUE ~ `tool-typology`               
    )
  ) %>% 
  mutate(
    `tool-typology` = case_when(
     # If Retouch is 1 and tool-typology is NA
       retouch == 1 & is.na(`tool-typology`) ~ "retouched piece",
       `sickle shine` == 1 & is.na(`tool-typology`) ~ "sickle shine",
       
      # For all other cases 
      TRUE ~ `tool-typology`                                       
    )
  )

# BM: take a look at tool typology
rev(sort(table(tl_final$`tool-typology`)))

                            utilized tool 
                                      360 
                          retouched piece 
                                      112 
                                    notch 
                                       81 
                      double side scraper 
                                       37 
                              denticulate 
                                       36 
                             side scraper 
                                       34 
                             sickle shine 
                                       25 
                         perforator-drill 
                                       19 
                         serrated scraper 
                                       17 
                         perforator-borer 
                                       17 
                              end scraper 
                                       12 
                             backed knife 
                                       10 
                          truncated piece 
                                        9 
                           perforator-awl 
                                        8 
                                    burin 
                                        8 
                             double notch 
                                        7 
                         perforator-point 
                                        6 
                       convergent scraper 
                                        5 
                               microburin 
                                        4 
      backed knife-naturally backed knife 
                                        4 
                                     used 
                                        3 
                            round scraper 
                                        3 
                        notch-denticulate 
                                        3 
                       geometric-triangle 
                                        3 
             perforator-borer;denticulate 
                                        2 
                         geometric-lunate 
                                        2 
             core tool-used core fragment 
                                        2 
                   core preparation piece 
                                        2 
                       backed;denticulate 
                                        2 
                    truncated piece;notch 
                                        1 
                    truncated piece-notch 
                                        1 
                       transverse scraper 
                                        1 
                    scraper-on core piece 
                                        1 
               scraper-convergent scraper 
                                        1 
                      round scraper;notch 
                                        1 
             round scraper on core tablet 
                                        1 
                      psedulevalois flake 
                                        1 
                   perforator-point;notch 
                                        1 
                perforator-borer; preform 
                                        1 
                     perforator-awl;notch 
                                        1 
perforator-awl on core rejuvenation piece 
                                        1 
                    notch;truncated piece 
                                        1 
                       notch-side scraper 
                                        1 
                        notch-end scraper 
                                        1 
                               flat burin 
                                        1 
            endscraper on truncated piece 
                                        1 
                     double notch scraper 
                                        1 
                            burin;scraper 
                                        1 
                      burin-notch-scraper 
                                        1 
# List of columns that should be numeric
columns_to_convert <- c("cortex", 
                        "upper", 
                        "lower", 
                        "midpoint", 
                        "length", 
                        "width", 
                        "utilization", 
                        "retouch",
                        "sickle shine")


# Convert each column to numeric
for (col_name in columns_to_convert) {
  # Replace non-numeric characters with NA
  # BM: this is quite an unusual method for doing this, 
  # where did you find it?
  tl_final[[col_name]][tl_final[[col_name]] %in% c("", "NA", "N/A")] <- NA
  # Convert to numeric
  tl_final[[col_name]] <- as.numeric(tl_final[[col_name]])
}

# BM: this is how I would convert those columns to numeric, 
# I think it's easier to read and requires less typing
# tl_final %>% 
#  mutate(across(all_of(columns_to_convert), parse_number))

# check the structure to see if they have been converted
str(tl_final)
tibble [3,917 × 24] (S3: tbl_df/tbl/data.frame)
 $ lithic_id         : chr [1:3917] "1" "2" "3" "4" ...
 $ TA                : chr [1:3917] "ta/34" "ta/34" "ta/34" "ta/34" ...
 $ area              : chr [1:3917] "ta" "ta" "ta" "ta" ...
 $ layer             : chr [1:3917] "e" "e" "e" "e" ...
 $ al                : chr [1:3917] "TA_e" "TA_e" "TA_e" "TA_e" ...
 $ cortex            : num [1:3917] 0 0 0 0 0 0 0 0 10 0 ...
 $ depth             : chr [1:3917] "30-40cm" "30-40cm" "30-40cm" "30-40cm" ...
 $ upper             : num [1:3917] 30 30 30 30 30 30 30 30 30 30 ...
 $ lower             : num [1:3917] 40 40 40 40 40 40 40 40 40 40 ...
 $ midpoint          : num [1:3917] 35 35 35 35 35 35 35 35 35 35 ...
 $ length            : num [1:3917] 34.5 18.5 17 15.5 15 11 23 23 33 37 ...
 $ width             : num [1:3917] 12.7 10.7 7.6 5.8 6.2 7.6 7.7 5 13.7 11.5 ...
 $ thickness         : chr [1:3917] "3.1" "1.2" "1.4" "1.1" ...
 $ typology          : chr [1:3917] NA NA NA NA ...
 $ utilization       : num [1:3917] 1 1 NA NA NA NA NA NA 1 NA ...
 $ sickle shine      : num [1:3917] NA NA NA NA NA NA NA NA NA NA ...
 $ retouch           : num [1:3917] NA NA NA NA NA NA NA 1 NA NA ...
 $ typology-tool-core: chr [1:3917] "tool" "tool" NA NA ...
 $ tool-typology     : chr [1:3917] "utilized tool" "utilized tool" NA NA ...
 $ blank             : chr [1:3917] "blade" "bladelet" "bladelet" "bladelet" ...
 $ blank part        : chr [1:3917] "complete" "med" "complete" "pro" ...
 $ core-typology     : chr [1:3917] NA NA NA NA ...
 $ core-fragment     : chr [1:3917] NA NA NA NA ...
 $ core-technology   : chr [1:3917] NA NA NA NA ...
#set the value of utilization to NA only for the rows where `sickle shine` == 1.


tl_final <- tl_final %>%
  rowwise() %>%
  mutate(utilization = ifelse(is.na(`sickle shine`) | is.na(utilization), utilization,
                              ifelse(`sickle shine` == 1 & utilization == 1, NA_real_, utilization))) %>%
  ungroup()
#number of `sickle shine` in clumn `sickle shine`=1 and tooltypegroup are not match: 
rev(sort(table(tl_final$tooltypegroup)))
integer(0)
rev(sort(table(tl_final$`sickle shine`)))
 1 
56 
#troubleshoot:
tl_final %>% filter(`sickle shine` == 1) %>% 
  select(`tool-typology`, 
         `sickle shine`)
# A tibble: 56 × 2
   `tool-typology` `sickle shine`
   <chr>                    <dbl>
 1 utilized tool                1
 2 utilized tool                1
 3 sickle shine                 1
 4 utilized tool                1
 5 utilized tool                1
 6 utilized tool                1
 7 sickle shine                 1
 8 sickle shine                 1
 9 sickle shine                 1
10 utilized tool                1
# ℹ 46 more rows
tl_final %>% filter(`tool-typology` == "sickle shine") %>% 
  select(`tool-typology`, `sickle shine`)
# A tibble: 25 × 2
   `tool-typology` `sickle shine`
   <chr>                    <dbl>
 1 sickle shine                 1
 2 sickle shine                 1
 3 sickle shine                 1
 4 sickle shine                 1
 5 sickle shine                 1
 6 sickle shine                 1
 7 sickle shine                 1
 8 sickle shine                 1
 9 sickle shine                 1
10 sickle shine                 1
# ℹ 15 more rows
tl_final <- tl_final %>%
  mutate(
    `tool-typology` = case_when(
      `sickle shine` == 1 ~ "sickle shine",
      utilization == 1 ~ "utilized tool",
      TRUE ~ `tool-typology`               
    )
  )


rev(sort(table(tl_final$`tool-typology`)))

                            utilized tool 
                                      329 
                          retouched piece 
                                      112 
                                    notch 
                                       81 
                             sickle shine 
                                       56 
                      double side scraper 
                                       37 
                              denticulate 
                                       36 
                             side scraper 
                                       34 
                         perforator-drill 
                                       19 
                         serrated scraper 
                                       17 
                         perforator-borer 
                                       17 
                              end scraper 
                                       12 
                             backed knife 
                                       10 
                          truncated piece 
                                        9 
                           perforator-awl 
                                        8 
                                    burin 
                                        8 
                             double notch 
                                        7 
                         perforator-point 
                                        6 
                       convergent scraper 
                                        5 
                               microburin 
                                        4 
      backed knife-naturally backed knife 
                                        4 
                                     used 
                                        3 
                            round scraper 
                                        3 
                        notch-denticulate 
                                        3 
                       geometric-triangle 
                                        3 
             perforator-borer;denticulate 
                                        2 
                         geometric-lunate 
                                        2 
             core tool-used core fragment 
                                        2 
                   core preparation piece 
                                        2 
                       backed;denticulate 
                                        2 
                    truncated piece;notch 
                                        1 
                    truncated piece-notch 
                                        1 
                       transverse scraper 
                                        1 
                    scraper-on core piece 
                                        1 
               scraper-convergent scraper 
                                        1 
                      round scraper;notch 
                                        1 
             round scraper on core tablet 
                                        1 
                      psedulevalois flake 
                                        1 
                   perforator-point;notch 
                                        1 
                perforator-borer; preform 
                                        1 
                     perforator-awl;notch 
                                        1 
perforator-awl on core rejuvenation piece 
                                        1 
                    notch;truncated piece 
                                        1 
                       notch-side scraper 
                                        1 
                        notch-end scraper 
                                        1 
                               flat burin 
                                        1 
            endscraper on truncated piece 
                                        1 
                     double notch scraper 
                                        1 
                            burin;scraper 
                                        1 
                      burin-notch-scraper 
                                        1 
# Creating tooltypegroup

tl_final <- tl_final %>%
  mutate(
    tooltypegroup = case_when(
      `tool-typology` %in%
        c(
          "end scraper",
          "side scraper",
          "double side scraper",
          "convergent scraper",
          "round scraper",
          "perforator-convergent scraper",
          "perforator-borer; preform",
          "scraper-on core piece",
          "endscraper on truncated piece",
          "round scraper",
          "transverse scraper",
          "core tool-used core fragment",
          "round scraper on core tablet"
        ) ~ "scraper",
      `tool-typology` %in%
        c(
          "perforator-borer",
          "perforator-drill",
          "perforator-point",
          "perforator-awl",
          "perforator-point;notch",
          "perforator-awl on core rejuvenation piece",
          "perforator-awl;notch",
          "perforator-borer;denticulate"
        ) ~ "Perforator",
      `tool-typology` %in%
        c(
          "backed knife",
          "backed knife-naturally backed knife",
          "backed;denticulate"
        ) ~ "backed pieces",
      `tool-typology` %in% c(
        "double notch",
        "denticulate",
        " denticulate",
        "notch-denticulate",
        "notch"
      ) ~ "denticulate-notch",
      `tool-typology` %in% c(
        "notch-side scraper",
        "notch-end scraper",
        "double notch scraper",
        "round scraper;notch"
      ) ~ "scraper-notch",
      `tool-typology` %in% c("geometric-triangle", "geometric-lunate") ~ "geometric",
      `tool-typology` == "serrated scraper" ~ "serrated scraper",
      `tool-typology` %in% c(
        "truncated piece",
        "truncated piece-notch",
        "truncated piece;notch",
        "notch;truncated piece"
      ) ~ "truncated pieces",
      
      # Represents NA group
      `tool-typology` %in% c("core preparation piece", "used", "psedulevalois flake") ~ NA_character_,
      `tool-typology` %in% c("burin", "flat burin", "burin;scraper", "burin-notch-scraper") ~ "burin",
      `tool-typology` == "microburin" ~ "microburin",
      `tool-typology` == "retouched piece" ~ "retouched piece",
      `tool-typology` == "utilized tool" ~ "utilized tool",
      `tool-typology` == "sickle shine" ~ "sickle shine",
      
      #classify any remaining values as NA
      TRUE ~ NA_character_
    )
  )

# Checking the unique values of tooltypegroup
rev(sort(table(tl_final$tooltypegroup)))

    utilized tool denticulate-notch   retouched piece           scraper 
              329               127               112                98 
     sickle shine        Perforator  serrated scraper     backed pieces 
               56                55                17                16 
 truncated pieces             burin         geometric     scraper-notch 
               12                11                 5                 4 
       microburin 
                4 
library(dplyr)
library(stringr)

# Define the patterns to search for
patterns <- c("denticulate-notch", "retouched piece", "scraper",
              "Perforator", "serrated scraper", "backed pieces",
              "truncated pieces", "burin", "geometric", "scraper-notch",
              "microburin")

# Update the `retouch` column based on the `tooltypegroup` column
tl_final <- tl_final %>%
  mutate(retouch = ifelse(str_detect(tooltypegroup, 
                                     str_c(patterns, collapse = "|")), 
                          1, retouch))

# View the first few rows to confirm
head(tl_final)
# A tibble: 6 × 25
  lithic_id TA    area  layer al    cortex depth   upper lower midpoint length
  <chr>     <chr> <chr> <chr> <chr>  <dbl> <chr>   <dbl> <dbl>    <dbl>  <dbl>
1 1         ta/34 ta    e     TA_e       0 30-40cm    30    40       35   34.5
2 2         ta/34 ta    e     TA_e       0 30-40cm    30    40       35   18.5
3 3         ta/34 ta    e     TA_e       0 30-40cm    30    40       35   17  
4 4         ta/34 ta    e     TA_e       0 30-40cm    30    40       35   15.5
5 5         ta/34 ta    e     TA_e       0 30-40cm    30    40       35   15  
6 6         ta/34 ta    e     TA_e       0 30-40cm    30    40       35   11  
# ℹ 14 more variables: width <dbl>, thickness <chr>, typology <chr>,
#   utilization <dbl>, `sickle shine` <dbl>, retouch <dbl>,
#   `typology-tool-core` <chr>, `tool-typology` <chr>, blank <chr>,
#   `blank part` <chr>, `core-typology` <chr>, `core-fragment` <chr>,
#   `core-technology` <chr>, tooltypegroup <chr>
rev(sort(table(tl_final$tooltypegroup)))

    utilized tool denticulate-notch   retouched piece           scraper 
              329               127               112                98 
     sickle shine        Perforator  serrated scraper     backed pieces 
               56                55                17                16 
 truncated pieces             burin         geometric     scraper-notch 
               12                11                 5                 4 
       microburin 
                4 
rev(sort(table(tl_final$retouch)))
  1 
486 
tl_final <- tl_final %>%
  mutate(`core-fragment` = if_else(!is.na(`core-typology`),
                                   NA_character_,
                                   `core-fragment`))  %>%
  mutate(`core-fragment` = if_else(!is.na(`core-typology`),
                                   NA_character_,
                                   `core-fragment`)) %>%
  mutate(
    `core-fragment` = case_when(
      `core-fragment` == "rejuvenation piece" ~ "rejuvenation piece",
      `core-fragment` == "rejuvention piece-side" ~ "rejuvenation piece",
      `core-fragment` == "core preparation piece-platform" ~ "core tablet",
      `core-fragment` == "core preparation" ~ "rejuvenation piece",
      `core-fragment` == "core preparation piece" ~ "rejuvenation piece",
      `core-fragment` == "core preperation" ~ "rejuvenation piece",
      `core-fragment` == "pyramid" ~ "pyramid",
      `core-fragment` == "pyramid core" ~ "pyramid",
      `core-fragment` == "pyramid-unidirectional" ~ "pyramid",
      `core-fragment` == "core fragment-pyramid" ~ "pyramid",
      `core-fragment` == "cylinder" ~ "cylinder/prismatic",
      `core-fragment` == "prismatic" ~ "cylinder/prismatic",
      `core-fragment` == "shapeless" ~ "cylinder/prismatic",
      `core-fragment` == "multidirectional core fragment" ~ "shapeless",
      `core-fragment` == "multidirectional flake core" ~ "shapeless",
      `core-fragment` == "multidirectional bladelet core" ~ "shapeless",
      `core-fragment` == "mixed core" ~ "shapeless",
      `core-fragment` == "mixed-percussion" ~ "shapeless",
      `core-fragment` == "mixed" ~ "shapeless",
      `core-fragment` == ("bipolar-percussion") ~ "bipolar",
      `core-fragment` == "flat" ~ "flat",
      `core-fragment` == "core on flake" ~ "core on flake",
      `core-fragment` == "bullet" ~ "bullet",
      TRUE ~ `core-fragment`
      
    )
  )  %>%
  mutate(
    core = case_when(
      `core-fragment` %in% c(
        "pyramid",
        "pyramid core",
        "pyramid-unidirectional",
        "core fragment-pyramid",
        "cylinder/prismatic",
        "shapeless",
        "multidirectional core fragment",
        "multidirectional flake core",
        "multidirectional bladelet core",
        "mixed core",
        "mixed-percussion",
        "mixed",
        "bipolar-percussion",
        "flat",
        "core on flake",
        "bullet"
      ) ~ `core-fragment`,
      TRUE ~ NA_character_
    ),
    corefrag = case_when(
      `core-fragment` %in% c(
        "rejuvenation piece",
        "rejuvention piece-side",
        "core preparation piece-platform",
        "core preparation",
        "core preparation piece",
        "core preperation",
        "crested bladelet" ,
        "primary flake" ,
        "primary blade"
      ) ~ `core-fragment`,
      TRUE ~ NA_character_
    )
  ) %>%
  # Convert empty strings to NA in `core-fragment` column
  mutate(`core-fragment` = if_else(`core-fragment` == "", NA_character_, `core-fragment`)) %>%
  # Convert "pyramid-percussion" to "pyramid" in `core-fragment` column
  mutate(
    `core-fragment` =
      if_else(
        `core-fragment` == "pyramid-percussion",
        "pyramid",
        `core-fragment`
      )
  ) %>%
  # Update existing `core` column with selected values from `core-fragment` column
  mutate(core = if_else(
    `core-fragment` %in%
      c(
        "pyramid",
        "cylinder/prismatic",
        "flat",
        "bullet",
        "core on flake",
        "pyramid"
      ),
    `core-fragment`,
    core
  )) %>%
  # Add 'core tablet' and 'core fragment' from `core-fragment` to `corefrag`
  mutate(
    corefrag = case_when(
      `core-fragment` == "core tablet" ~ "core tablet",
      `core-fragment` == "core fragment" ~ "core fragment",
      TRUE ~ corefrag
    )
  ) %>%
  # Transfer 'rejuvenation piece' and 'core fragment' from `core-typology` to `corefrag`
  mutate(
    corefrag = case_when(
      `core-typology` == "rejuvenation piece" ~ "rejuvenation piece",
      `core-typology` == "core fragment" ~ "core fragment",
      TRUE ~ corefrag
    )
  ) %>%
  # Remove 'rejuvenation piece' and 'core fragment' from `core-typology`
  mutate(`core-typology` = if_else(
    `core-typology` %in% c("rejuvenation piece", "core fragment"),
    NA_character_,
    `core-typology`
  ))  %>% 
# Update the 'blank' column based on conditions in the 'core-fragment' column
  mutate(blank = if_else(
    `core-fragment` %in% c(
      "core fragment",
      "core tablet",
      "rejuvenation piece",
      "pyramid",
      "crested bladelet",
      "shapeless",
      "primary flake",
      "flat",
      "bullet",
      "core on flake",
      "cylinder/prismatic",
      "primary blade",
      "rejuvenation piece-side",
      "core platform rejuvention"
    ),
    NA_character_,
    blank
  ))


# take a look
rev(sort(table(tl_final$core)))

           pyramid          shapeless             bullet               flat 
                45                  7                  5                  4 
cylinder/prismatic      core on flake 
                 2                  2 
rev(sort(table(tl_final$corefrag)))

rejuvenation piece        core tablet      core fragment      primary flake 
                58                 22                  8                  3 
     primary blade   crested bladelet 
                 1                  1 
rev(sort(table(tl_final$`core-fragment`)))

       rejuvenation piece                   pyramid               core tablet 
                       56                        45                        22 
                       NA                 shapeless             core fragment 
                       18                         7                         7 
                   bullet                      flat             primary flake 
                        5                         4                         3 
       cylinder/prismatic             core on flake   rejuvenation piece-side 
                        2                         2                         1 
            primary blade          crested bladelet core platform rejuvention 
                        1                         1                         1 
                  bipolar 
                        1 
rev(sort(table(tl_final$blank)))

bladelet    blade    flake 
    2630      833      190 
library(dplyr)

# Filter the data to include only the areas 'ta', 'd1', and 'tp1'
tl_final_area <- tl_final %>%
  filter(area %in% c("ta", "d1", "tp1"))

Summary tables: 1. AREA

# Create a summary table
summary_table_area <- tl_final %>%
  group_by(area) %>%
  summarise(
    `Cores (n)` = sum(!is.na(core) & core != ""),
    `Core rejuvenations pieces (n)` = sum(!is.na(corefrag) &
                                            corefrag != ""),
    `Blade (n)` = sum(blank == "blade", na.rm = TRUE),
    `Flake (n)` = sum(blank == "flake", na.rm = TRUE),
    `Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
    `Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
    `Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
    `Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
  )

# BM: looks like this is area and layer, is that right? I see c1, d1, d2, d3, d4 etc.
# SS: those are different excavated areas, we mainly consider ta, tp1, and d1.
knitr::kable(summary_table_area)
area Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n)
b 2 1 1 0 0 0 0 0
c 0 0 3 1 0 1 0 0
c1 0 0 4 0 2 2 0 0
d1 5 4 33 5 109 21 5 1
d3 0 0 8 1 20 6 5 0
d4 1 0 8 1 13 2 3 0
d5 0 0 1 0 1 1 1 0
dh 0 0 3 0 6 1 0 0
surface 6 0 12 2 14 6 1 1
ta 51 80 708 151 2246 408 282 48
tp1 0 8 52 29 219 38 32 6
library(kableExtra)

kable(summary_table_area, 
      caption = "Table: Summary by Area", 
      align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = F, 
                font_size = 12) %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Summary by Area
area Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n)
b 2 1 1 0 0 0 0 0
c 0 0 3 1 0 1 0 0
c1 0 0 4 0 2 2 0 0
d1 5 4 33 5 109 21 5 1
d3 0 0 8 1 20 6 5 0
d4 1 0 8 1 13 2 3 0
d5 0 0 1 0 1 1 1 0
dh 0 0 3 0 6 1 0 0
surface 6 0 12 2 14 6 1 1
ta 51 80 708 151 2246 408 282 48
tp1 0 8 52 29 219 38 32 6

2.LAYER

# Create a summary table
summary_table_layer <- tl_final %>%
  group_by(layer) %>% 
  summarise(
    `Cores (n)` = sum(!is.na(core)),  # Count non-NA core entries
    `Core rejuvenations pieces (n)` = sum(!is.na(corefrag)),  # Count non-NA corefrag entries
    `Blade (n)` = sum(blank == "blade", na.rm = TRUE),
    `Flake (n)` = sum(blank == "flake", na.rm = TRUE),
    `Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
    `Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
    `Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
    `Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
  )
# Generate the table
kable(summary_table_layer, 
      caption = "Table: Summary by Layer", 
      align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = F, 
                font_size = 12) %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Summary by Layer
layer Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n)
a 1 2 21 0 57 9 1 0
c 4 9 63 34 266 47 36 7
d 29 44 465 123 1309 239 152 27
e 22 36 243 28 937 169 130 21
NA 9 2 41 5 61 22 10 1

AREA-LAYER:

# Create a summary table based on the 'al' column
summary_table_al <- tl_final %>%
  group_by(al) %>%  
  summarise(
    `Cores (n)` = sum(!is.na(core)),  
    `Core rejuvenations pieces (n)` = sum(!is.na(corefrag)),  
    `Blade (n)` = sum(blank == "blade", na.rm = TRUE),
    `Flake (n)` = sum(blank == "flake", na.rm = TRUE),
    `Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
    `Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
    `Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
    `Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
  )
# Generate the table

kable(summary_table_al, 
      caption = "Table: Summary by Al", 
      align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = F, 
                font_size = 12) %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Summary by Al
al Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n)
B_NA 2 1 1 0 0 0 0 0
C1_NA 0 0 4 0 2 2 0 0
C_NA 0 0 3 1 0 1 0 0
D1_NA 0 0 0 0 1 1 0 0
D1_a 1 2 21 0 57 9 1 0
D1_c 4 2 12 5 51 11 4 1
D3_NA 0 0 8 1 20 6 5 0
D4_NA 1 0 8 1 13 2 3 0
D5_NA 0 0 1 0 1 1 1 0
DH_NA 0 0 3 0 6 1 0 0
SURFACE_NA 6 0 12 2 14 6 1 1
TA_d 29 44 465 123 1309 239 152 27
TA_e 22 36 243 28 937 169 130 21
TP1_NA 0 1 1 0 4 2 0 0
TP1_c 0 7 51 29 215 36 32 6

Techno-Typo:

# Prepare data for Summary table-area
summary_table_area <- tl_final %>%
  filter(area %in% c("ta", "d1", "tp1")) %>%
  group_by(area) %>%
  summarise(
    blade_count = sum(blank == "blade", na.rm = TRUE),
    flake_count = sum(blank == "flake", na.rm = TRUE),
    bladelet_count = sum(blank == "bladelet", na.rm = TRUE),
    tool_count = sum(retouch == 1, na.rm = TRUE) + sum(utilization == 1, na.rm = TRUE),
    core_count = sum(!is.na(`core-typology`), na.rm = TRUE),
    core_rejuvenation_count = sum(!is.na(`corefrag`), na.rm = TRUE),
    retouched_tool_count = sum(retouch == 1, na.rm = TRUE),
    utilized_tool_count = sum(utilization == 1, na.rm = TRUE),
    shine_tool_count = sum(`sickle shine` == 1, na.rm = TRUE),
    total = n()
  )


summary_table_area <- summary_table_area %>%
  add_row(
    area = "Total",
    blade_count =              sum(.$blade_count, na.rm = TRUE),
    flake_count =              sum(.$flake_count, na.rm = TRUE),
    bladelet_count =           sum(.$bladelet_count, na.rm = TRUE),
    tool_count =               sum(.$tool_count, na.rm = TRUE),
    core_count =               sum(.$core_count, na.rm = TRUE),
    core_rejuvenation_count =  sum(.$core_rejuvenation_count, na.rm = TRUE),
    retouched_tool_count =     sum(.$retouched_tool_count, na.rm = TRUE),
    utilized_tool_count =      sum(.$utilized_tool_count, na.rm = TRUE),
    shine_tool_count =         sum(.$shine_tool_count, na.rm = TRUE),
    total =                    sum(.$total, na.rm = TRUE)  # Explicitly setting the total
  )

# Adding a new row with total counts
summary_table_area <- summary_table_area %>%
  add_row(
    area = "Total",
    blade_count =              sum(.$blade_count, na.rm = TRUE),
    flake_count =              sum(.$flake_count, na.rm = TRUE),
    bladelet_count =           sum(.$bladelet_count, na.rm = TRUE),
    tool_count =               sum(.$tool_count, na.rm = TRUE),
    core_count =               sum(.$core_count, na.rm = TRUE),
    core_rejuvenation_count =  sum(.$core_rejuvenation_count, na.rm = TRUE),
    retouched_tool_count =     sum(.$retouched_tool_count, na.rm = TRUE),
    utilized_tool_count =      sum(.$utilized_tool_count, na.rm = TRUE),
    shine_tool_count =         sum(.$shine_tool_count, na.rm = TRUE),
    total =                    sum(.$total, na.rm = TRUE)  # Explicitly setting the total
  )
# Prepare data for Summary table-area_layer(al)
summary_table_al <- tl_final %>%
  filter(area %in% c("ta", "d1", "tp1")) %>% 
  group_by(al) %>% 
  summarise(
    blade_count = sum(blank == "blade", na.rm = TRUE),
    flake_count = sum(blank == "flake", na.rm = TRUE),
    bladelet_count = sum(blank == "bladelet", na.rm = TRUE),
    tool_count = sum(retouch == 1, na.rm = TRUE) + sum(utilization == 1, na.rm = TRUE),
    core_count = sum(!is.na(`core-typology`), na.rm = TRUE),
    core_rejuvenation_count = sum(!is.na(`corefrag`), na.rm = TRUE),
    retouched_tool_count = sum(retouch == 1, na.rm = TRUE),
    utilized_tool_count = sum(utilization == 1, na.rm = TRUE),
    shine_tool_count = sum(`sickle shine` == 1, na.rm = TRUE),
    total = n()
  )

# Adding a new row with total counts
summary_table_al <- summary_table_al %>% 
  add_row(
    al = "Total",
    blade_count =              sum(.$blade_count, na.rm = TRUE),
    flake_count =              sum(.$flake_count, na.rm = TRUE),
    bladelet_count =           sum(.$bladelet_count, na.rm = TRUE),
    tool_count =               sum(.$tool_count, na.rm = TRUE),
    core_count =               sum(.$core_count, na.rm = TRUE),
    core_rejuvenation_count =  sum(.$core_rejuvenation_count, na.rm = TRUE),
    retouched_tool_count =     sum(.$retouched_tool_count, na.rm = TRUE),
    utilized_tool_count =      sum(.$utilized_tool_count, na.rm = TRUE),
    shine_tool_count =         sum(.$shine_tool_count, na.rm = TRUE),
    total =                    sum(.$total, na.rm = TRUE)  
  )

rev(sort(table(tl_final$tooltypegroup)))

    utilized tool denticulate-notch   retouched piece           scraper 
              329               127               112                98 
     sickle shine        Perforator  serrated scraper     backed pieces 
               56                55                17                16 
 truncated pieces             burin         geometric     scraper-notch 
               12                11                 5                 4 
       microburin 
                4 
#explore tool type group

summary_table_tooltype <- tl_final %>%
  filter(tooltypegroup != 'utilized tool') %>%  # Exclude 'utilized tool'
  group_by(tooltypegroup) %>% 
  summarise(
   
  )
#generate a table

summary_table_al <- summary_table_al %>%
  filter(!(al %in% c("D1_NA", "TP1_NA")))

kable(
  summary_table_al,
  col.names = c(
    "Area-Layer",
    "Blade",
    "Flake",
    "Bladelet",
    "Tools",
    "Cores",
    "Core Rejuvenations",
    "Retouched Tools",
    "Utilized Tools",
    "Sickle Shine",
    "Total"
  ),
  caption = "Table: Summary ",
  align = 'c'
) %>%
  kable_styling(
    bootstrap_options = c("striped", 
                          "hover", 
                          "condensed"),
    full_width = FALSE,
    font_size = 12
  ) %>%
  row_spec(0, 
           bold = TRUE, 
           font_size = 14)
Table: Summary
Area-Layer Blade Flake Bladelet Tools Cores Core Rejuvenations Retouched Tools Utilized Tools Sickle Shine Total
D1_a 21 0 57 10 0 2 9 1 0 81
D1_c 12 5 51 15 1 2 11 4 1 75
TA_d 465 123 1309 391 51 44 239 152 27 2031
TA_e 243 28 937 299 38 36 169 130 21 1301
TP1_c 51 29 215 68 2 7 36 32 6 306
Total 793 185 2574 786 92 92 467 319 55 3802
# Create a summary table for typology based on area

summary_table_tool_area <- tl_final %>%
  filter(area %in% c("ta", "d1", "tp1")) %>%
  filter(!is.na(tooltypegroup), tooltypegroup != "") %>%  # Exclude rows where 'tooltypegroup' is NA or empty
  group_by(area, tooltypegroup) %>%  # Group the data by area and tooltypegroup
  tally() %>%  # Count the number of rows in each group
  arrange(area, tooltypegroup) %>%  # Arrange by area and tooltypegroup
  spread(key = area, value = n, fill = 0)  # Spread the 'area' column into multiple columns

# Add a "Total" column that sums each row
summary_table_tool_area <- summary_table_tool_area %>%
  mutate(Total = rowSums(select(.,-tooltypegroup)))

total_row <- summary_table_tool_area %>%
  select(-tooltypegroup) %>%
  summarise(across(everything(), \(x) sum(x, na.rm = TRUE))) %>%
  mutate(tooltypegroup = "Total")

summary_table_tool_area <-
  bind_rows(summary_table_tool_area, total_row)
kable(
  summary_table_tool_area,
  col.names = c("Tools", "D1", "TA", "TP1", "Total"),
  caption = "Table: Tool Typology in three different main areas.",
  align = 'c'
) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = F,
    font_size = 12
  ) %>%
  column_spec(1, extra_css = "text-align:left;") %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Tool Typology in three different main areas.
Tools D1 TA TP1 Total
backed pieces 0 11 2 13
burin 2 8 1 11
denticulate-notch 4 110 7 121
geometric 3 2 0 5
microburin 0 4 0 4
Perforator 2 50 2 54
retouched piece 5 89 15 109
scraper 4 84 6 94
scraper-notch 0 4 0 4
serrated scraper 0 15 1 16
sickle shine 1 48 6 55
truncated pieces 1 10 0 11
utilized tool 5 282 32 319
Total 27 717 72 816
# Create the summary table based on layer
summary_table1_layer <- tl_final %>%
  filter(area %in% c("ta", "d1", "tp1")) %>%
  group_by(layer) %>%
  summarise(
    numb_retouched = sum(retouch == 1, na.rm = TRUE),
    numb_cores = sum(!is.na(`core-typology`), na.rm = TRUE),
    total_lithics = n(),
    percent_retouch = round((numb_retouched / total_lithics) * 100, 2)
  )
# Create a summary table based on the 'depth', 'area', and 'layer' columns
tl_final <- tl_final %>%
  mutate(depth = gsub("cm", "", depth))


summary_table_depth_area_layer <- tl_final %>%
  group_by(TA, depth, area, layer, upper, lower) %>%  
  summarise(
    `Cores (n)` = sum(!is.na(core)),  
    `Core rejuvenations pieces (n)` = sum(!is.na(corefrag)),  
    `Blade (n)` = sum(blank == "blade", na.rm = TRUE),
    `Flake (n)` = sum(blank == "flake", na.rm = TRUE),
    `Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
    `Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
    `Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
    `Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
  )

# Generate the table
library(kableExtra)

kable(summary_table_depth_area_layer, 
      caption = "Table: Summary by Depth, Area, and Layer", 
      align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = F, 
                font_size = 12) %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Summary by Depth, Area, and Layer
TA depth area layer upper lower Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n)
b/1 0-10 b NA 0 10 2 1 1 0 0 0 0 0
c/01 0-10 c NA 0 10 0 0 3 1 0 1 0 0
c1/02 0-20 c1 NA 0 20 0 0 4 0 2 2 0 0
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1
d1/23 20-30 d1 c 20 30 0 0 0 0 1 0 0 0
d1/46 40-60 d1 a 40 60 0 1 6 0 32 4 0 0
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0
d1/67 60-70 d1 a 60 70 1 1 14 0 19 5 0 0
d1/78 70-80 d1 a 70 80 0 0 1 0 5 0 1 0
d1/all NA d1 NA NA NA 0 0 0 0 1 1 0 0
d3/02 0-20 d3 NA 0 20 0 0 8 1 20 6 5 0
d4/02 0-20 d4 NA 0 20 1 0 8 1 13 2 3 0
d5/01 0-10 d5 NA 0 10 0 0 1 0 1 1 1 0
dh/12 10-20 dh NA 10 20 0 0 3 0 6 1 0 0
surface NA surface NA NA NA 6 0 12 2 14 6 1 1
ta/125 120-150 ta d 120 150 0 13 97 27 204 46 24 3
ta/158 150-180 ta d 150 180 18 12 98 37 338 63 25 4
ta/189 180-190 ta d 180 190 0 3 39 13 115 29 13 2
ta/190 190-200 ta d 190 200 0 1 38 7 88 17 10 0
ta/201 200-210 ta d 200 210 1 5 22 7 72 9 11 4
ta/212 210-220 ta d 210 220 0 2 6 5 60 2 9 0
ta/223 220-230 ta d 220 230 0 0 18 1 47 2 13 2
ta/234 230-240 ta d 230 240 2 2 23 10 80 12 13 1
ta/235 230-250 ta d 230 250 2 1 4 0 5 0 0 0
ta/235/f1 230-250 ta d 230 250 0 0 8 1 16 3 1 0
ta/256 250-260 ta d 250 260 6 2 60 7 102 24 15 4
ta/267 260-270 ta d 260 270 0 3 13 1 68 5 6 0
ta/3 0-30 ta e 0 30 1 11 66 8 275 39 46 9
ta/34 30-40 ta e 30 40 3 9 54 2 232 47 27 2
ta/45 40-50 ta e 40 50 9 6 61 5 249 31 28 5
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3
ta/67 60-70 ta e 60 70 5 7 10 7 21 20 7 2
ta/72 70-120 ta d 70 120 0 0 39 7 114 27 12 7
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4
tp1/101 100-110 tp1 c 100 110 0 0 0 0 3 0 0 0
tp1/112 110-120 tp1 c 110 120 0 0 2 0 1 0 0 0
tp1/123 120-130 tp1 c 120 130 0 0 0 0 2 0 0 0
tp1/124 120-140 tp1 c 120 140 0 0 0 1 6 2 0 0
tp1/13 10-30 tp1 c 10 30 0 0 2 2 12 0 3 0
tp1/19 10-90 tp1 c 10 90 0 0 0 0 4 0 1 0
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0
tp1/23 20-30 tp1 c 20 30 0 0 1 0 2 0 1 0
tp1/34 30-40 tp1 c 30 40 0 2 0 6 4 0 0 0
tp1/45 40-50 tp1 c 40 50 0 0 3 6 12 4 2 0
tp1/51 50-100 tp1 c 50 100 0 0 2 0 8 0 0 0
tp1/557 557 tp1 NA 557 NA 0 0 0 0 1 1 0 0
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0
tp1/57 50-70 tp1 c 50 70 0 1 10 0 47 8 6 2
tp1/667 667 tp1 NA 667 NA 0 1 1 0 3 1 0 0
tp1/89 80-90 tp1 c 80 90 0 0 3 0 5 0 0 0
tp1/90 90-100 tp1 c 90 100 0 0 4 1 11 1 0 0
tp1/91 90-100 tp1 c 90 100 0 0 0 0 4 0 0 0
# Generate a summary table by grouping by 'depth' and 'area'
summary_table_depth_tool_type <- tl_final %>%
  group_by(area, depth) %>%
  summarise(tool_type = n_distinct(tooltypegroup, na.rm = TRUE), .groups = 'drop')

# Create a full summary table by joining it back to the original summary table based on 'depth' and 'area'
summary_table_depth_area_layer <- summary_table_depth_area_layer %>%
  left_join(summary_table_depth_tool_type, by = c("area", "depth"))

# Remove the existing 'tool_type' if it exists
if ("tool_type" %in% names(summary_table_depth_area_layer)) {
  summary_table_depth_area_layer <- summary_table_depth_area_layer %>%
    select(-tool_type)
}

# Join again based on 'depth', this time being specific about what we want
summary_table_depth_area_layer <- 
  summary_table_depth_area_layer %>%
  left_join(summary_table_depth_tool_type %>% select(depth, tool_type), 
            by = "depth")

# Generate the table
library(kableExtra)

kable(summary_table_depth_area_layer, 
      caption = "Table: Summary by Depth, Area, and Layer", 
      align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = F, 
                font_size = 12) %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Summary by Depth, Area, and Layer
TA depth area layer upper lower Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n) tool_type
b/1 0-10 b NA 0 10 2 1 1 0 0 0 0 0 0
b/1 0-10 b NA 0 10 2 1 1 0 0 0 0 0 1
b/1 0-10 b NA 0 10 2 1 1 0 0 0 0 0 2
b/1 0-10 b NA 0 10 2 1 1 0 0 0 0 0 7
c/01 0-10 c NA 0 10 0 0 3 1 0 1 0 0 0
c/01 0-10 c NA 0 10 0 0 3 1 0 1 0 0 1
c/01 0-10 c NA 0 10 0 0 3 1 0 1 0 0 2
c/01 0-10 c NA 0 10 0 0 3 1 0 1 0 0 7
c1/02 0-20 c1 NA 0 20 0 0 4 0 2 2 0 0 2
c1/02 0-20 c1 NA 0 20 0 0 4 0 2 2 0 0 8
c1/02 0-20 c1 NA 0 20 0 0 4 0 2 2 0 0 4
c1/02 0-20 c1 NA 0 20 0 0 4 0 2 2 0 0 3
c1/02 0-20 c1 NA 0 20 0 0 4 0 2 2 0 0 1
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 2
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 8
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 4
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 3
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 1
d1/23 20-30 d1 c 20 30 0 0 0 0 1 0 0 0 0
d1/23 20-30 d1 c 20 30 0 0 0 0 1 0 0 0 1
d1/46 40-60 d1 a 40 60 0 1 6 0 32 4 0 0 2
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0 0
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0 7
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0 1
d1/67 60-70 d1 a 60 70 1 1 14 0 19 5 0 0 3
d1/67 60-70 d1 a 60 70 1 1 14 0 19 5 0 0 7
d1/78 70-80 d1 a 70 80 0 0 1 0 5 0 1 0 1
d1/all NA d1 NA NA NA 0 0 0 0 1 1 0 0 1
d1/all NA d1 NA NA NA 0 0 0 0 1 1 0 0 6
d3/02 0-20 d3 NA 0 20 0 0 8 1 20 6 5 0 2
d3/02 0-20 d3 NA 0 20 0 0 8 1 20 6 5 0 8
d3/02 0-20 d3 NA 0 20 0 0 8 1 20 6 5 0 4
d3/02 0-20 d3 NA 0 20 0 0 8 1 20 6 5 0 3
d3/02 0-20 d3 NA 0 20 0 0 8 1 20 6 5 0 1
d4/02 0-20 d4 NA 0 20 1 0 8 1 13 2 3 0 2
d4/02 0-20 d4 NA 0 20 1 0 8 1 13 2 3 0 8
d4/02 0-20 d4 NA 0 20 1 0 8 1 13 2 3 0 4
d4/02 0-20 d4 NA 0 20 1 0 8 1 13 2 3 0 3
d4/02 0-20 d4 NA 0 20 1 0 8 1 13 2 3 0 1
d5/01 0-10 d5 NA 0 10 0 0 1 0 1 1 1 0 0
d5/01 0-10 d5 NA 0 10 0 0 1 0 1 1 1 0 1
d5/01 0-10 d5 NA 0 10 0 0 1 0 1 1 1 0 2
d5/01 0-10 d5 NA 0 10 0 0 1 0 1 1 1 0 7
dh/12 10-20 dh NA 10 20 0 0 3 0 6 1 0 0 1
surface NA surface NA NA NA 6 0 12 2 14 6 1 1 1
surface NA surface NA NA NA 6 0 12 2 14 6 1 1 6
ta/125 120-150 ta d 120 150 0 13 97 27 204 46 24 3 11
ta/158 150-180 ta d 150 180 18 12 98 37 338 63 25 4 12
ta/189 180-190 ta d 180 190 0 3 39 13 115 29 13 2 12
ta/190 190-200 ta d 190 200 0 1 38 7 88 17 10 0 7
ta/201 200-210 ta d 200 210 1 5 22 7 72 9 11 4 6
ta/212 210-220 ta d 210 220 0 2 6 5 60 2 9 0 3
ta/223 220-230 ta d 220 230 0 0 18 1 47 2 13 2 4
ta/234 230-240 ta d 230 240 2 2 23 10 80 12 13 1 7
ta/235 230-250 ta d 230 250 2 1 4 0 5 0 0 0 3
ta/235/f1 230-250 ta d 230 250 0 0 8 1 16 3 1 0 3
ta/256 250-260 ta d 250 260 6 2 60 7 102 24 15 4 8
ta/267 260-270 ta d 260 270 0 3 13 1 68 5 6 0 4
ta/3 0-30 ta e 0 30 1 11 66 8 275 39 46 9 7
ta/34 30-40 ta e 30 40 3 9 54 2 232 47 27 2 9
ta/34 30-40 ta e 30 40 3 9 54 2 232 47 27 2 0
ta/45 40-50 ta e 40 50 9 6 61 5 249 31 28 5 7
ta/45 40-50 ta e 40 50 9 6 61 5 249 31 28 5 4
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3 0
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3 7
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3 1
ta/67 60-70 ta e 60 70 5 7 10 7 21 20 7 2 3
ta/67 60-70 ta e 60 70 5 7 10 7 21 20 7 2 7
ta/72 70-120 ta d 70 120 0 0 39 7 114 27 12 7 9
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 0
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 1
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 2
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 7
tp1/101 100-110 tp1 c 100 110 0 0 0 0 3 0 0 0 0
tp1/112 110-120 tp1 c 110 120 0 0 2 0 1 0 0 0 0
tp1/123 120-130 tp1 c 120 130 0 0 0 0 2 0 0 0 0
tp1/124 120-140 tp1 c 120 140 0 0 0 1 6 2 0 0 2
tp1/13 10-30 tp1 c 10 30 0 0 2 2 12 0 3 0 1
tp1/19 10-90 tp1 c 10 90 0 0 0 0 4 0 1 0 1
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 2
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 8
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 4
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 3
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 1
tp1/23 20-30 tp1 c 20 30 0 0 1 0 2 0 1 0 0
tp1/23 20-30 tp1 c 20 30 0 0 1 0 2 0 1 0 1
tp1/34 30-40 tp1 c 30 40 0 2 0 6 4 0 0 0 9
tp1/34 30-40 tp1 c 30 40 0 2 0 6 4 0 0 0 0
tp1/45 40-50 tp1 c 40 50 0 0 3 6 12 4 2 0 7
tp1/45 40-50 tp1 c 40 50 0 0 3 6 12 4 2 0 4
tp1/51 50-100 tp1 c 50 100 0 0 2 0 8 0 0 0 0
tp1/557 557 tp1 NA 557 NA 0 0 0 0 1 1 0 0 1
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0 0
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0 7
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0 1
tp1/57 50-70 tp1 c 50 70 0 1 10 0 47 8 6 2 4
tp1/667 667 tp1 NA 667 NA 0 1 1 0 3 1 0 0 1
tp1/89 80-90 tp1 c 80 90 0 0 3 0 5 0 0 0 0
tp1/90 90-100 tp1 c 90 100 0 0 4 1 11 1 0 0 1
tp1/91 90-100 tp1 c 90 100 0 0 0 0 4 0 0 0 1
# Specify the exact columns want to keep
desired_columns <- c("TA", "depth", "area", "layer", "upper", "lower", 
                     "Cores (n)", "Core rejuvenations pieces (n)", 
                     "Blade (n)", "Flake (n)", "Bladelet (n)", 
                     "Retouched Tools (n)", "Utilized (n)", "Sickle Shine (n)",
                     "tool_type")  # Only keep this 'tool_type'

# Filter the tl_final dataframe
summary_table_depth_area_layer <- summary_table_depth_area_layer %>%
  filter(area %in% c('ta', 'd1', 'tp1'))

# Generate the table
library(kableExtra)

kable(summary_table_depth_area_layer, 
      caption = "Table: Summary by Depth, Area, and Layer", 
      align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = F, 
                font_size = 12) %>%
  row_spec(0, bold = TRUE, font_size = 14)
Table: Summary by Depth, Area, and Layer
TA depth area layer upper lower Cores (n) Core rejuvenations pieces (n) Blade (n) Flake (n) Bladelet (n) Retouched Tools (n) Utilized (n) Sickle Shine (n) tool_type
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 2
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 8
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 4
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 3
d1/02 0-20 d1 c 0 20 4 2 12 5 50 11 4 1 1
d1/23 20-30 d1 c 20 30 0 0 0 0 1 0 0 0 0
d1/23 20-30 d1 c 20 30 0 0 0 0 1 0 0 0 1
d1/46 40-60 d1 a 40 60 0 1 6 0 32 4 0 0 2
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0 0
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0 7
d1/56 50-60 d1 a 50 60 0 0 0 0 1 0 0 0 1
d1/67 60-70 d1 a 60 70 1 1 14 0 19 5 0 0 3
d1/67 60-70 d1 a 60 70 1 1 14 0 19 5 0 0 7
d1/78 70-80 d1 a 70 80 0 0 1 0 5 0 1 0 1
d1/all NA d1 NA NA NA 0 0 0 0 1 1 0 0 1
d1/all NA d1 NA NA NA 0 0 0 0 1 1 0 0 6
ta/125 120-150 ta d 120 150 0 13 97 27 204 46 24 3 11
ta/158 150-180 ta d 150 180 18 12 98 37 338 63 25 4 12
ta/189 180-190 ta d 180 190 0 3 39 13 115 29 13 2 12
ta/190 190-200 ta d 190 200 0 1 38 7 88 17 10 0 7
ta/201 200-210 ta d 200 210 1 5 22 7 72 9 11 4 6
ta/212 210-220 ta d 210 220 0 2 6 5 60 2 9 0 3
ta/223 220-230 ta d 220 230 0 0 18 1 47 2 13 2 4
ta/234 230-240 ta d 230 240 2 2 23 10 80 12 13 1 7
ta/235 230-250 ta d 230 250 2 1 4 0 5 0 0 0 3
ta/235/f1 230-250 ta d 230 250 0 0 8 1 16 3 1 0 3
ta/256 250-260 ta d 250 260 6 2 60 7 102 24 15 4 8
ta/267 260-270 ta d 260 270 0 3 13 1 68 5 6 0 4
ta/3 0-30 ta e 0 30 1 11 66 8 275 39 46 9 7
ta/34 30-40 ta e 30 40 3 9 54 2 232 47 27 2 9
ta/34 30-40 ta e 30 40 3 9 54 2 232 47 27 2 0
ta/45 40-50 ta e 40 50 9 6 61 5 249 31 28 5 7
ta/45 40-50 ta e 40 50 9 6 61 5 249 31 28 5 4
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3 0
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3 7
ta/56 50-60 ta e 50 60 4 3 52 6 160 32 22 3 1
ta/67 60-70 ta e 60 70 5 7 10 7 21 20 7 2 3
ta/67 60-70 ta e 60 70 5 7 10 7 21 20 7 2 7
ta/72 70-120 ta d 70 120 0 0 39 7 114 27 12 7 9
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 0
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 1
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 2
tp1/01 0-10 tp1 c 0 10 0 2 20 8 85 19 19 4 7
tp1/101 100-110 tp1 c 100 110 0 0 0 0 3 0 0 0 0
tp1/112 110-120 tp1 c 110 120 0 0 2 0 1 0 0 0 0
tp1/123 120-130 tp1 c 120 130 0 0 0 0 2 0 0 0 0
tp1/124 120-140 tp1 c 120 140 0 0 0 1 6 2 0 0 2
tp1/13 10-30 tp1 c 10 30 0 0 2 2 12 0 3 0 1
tp1/19 10-90 tp1 c 10 90 0 0 0 0 4 0 1 0 1
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 2
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 8
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 4
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 3
tp1/2 0-20 tp1 c 0 20 0 1 2 0 4 1 0 0 1
tp1/23 20-30 tp1 c 20 30 0 0 1 0 2 0 1 0 0
tp1/23 20-30 tp1 c 20 30 0 0 1 0 2 0 1 0 1
tp1/34 30-40 tp1 c 30 40 0 2 0 6 4 0 0 0 9
tp1/34 30-40 tp1 c 30 40 0 2 0 6 4 0 0 0 0
tp1/45 40-50 tp1 c 40 50 0 0 3 6 12 4 2 0 7
tp1/45 40-50 tp1 c 40 50 0 0 3 6 12 4 2 0 4
tp1/51 50-100 tp1 c 50 100 0 0 2 0 8 0 0 0 0
tp1/557 557 tp1 NA 557 NA 0 0 0 0 1 1 0 0 1
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0 0
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0 7
tp1/56 50-60 tp1 c 50 60 0 1 2 5 5 1 0 0 1
tp1/57 50-70 tp1 c 50 70 0 1 10 0 47 8 6 2 4
tp1/667 667 tp1 NA 667 NA 0 1 1 0 3 1 0 0 1
tp1/89 80-90 tp1 c 80 90 0 0 3 0 5 0 0 0 0
tp1/90 90-100 tp1 c 90 100 0 0 4 1 11 1 0 0 1
tp1/91 90-100 tp1 c 90 100 0 0 0 0 4 0 0 0 1
#Here, I've imported the table 'Summary by Depth, Area, Layer' into Google Sheets for easier management.
#I thought this format would simplify the process of those depths needed to be splitting up.

# BM: looks like you need this data starting from around here in the document

library(tidyverse)
library(googlesheets4)

google_sheet_url <- 
  "https://docs.google.com/spreadsheets/d/1Q0QZESk412ZQLE24yPs6Rg-7Y9OMX63DHoXeIPNAIFM/edit#gid=0"
sum_depth_sheet <- read_sheet(google_sheet_url)



# Create the 'label' column
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(label = paste(area, layer, level, sep = "_"))

# Add a suffix only to duplicates
sum_depth_sheet <- sum_depth_sheet %>%
  group_by(label) %>%
  mutate(suffix = case_when(
    n() == 1 ~ NA_character_,
    TRUE ~ letters[row_number()]
  )) %>%
  ungroup()

# Append the suffix to 'label'
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(label = if_else(is.na(suffix), label, paste0(label, "_", suffix))) %>%
  select(-suffix)

# Relocate 'label' column after 'level'
sum_depth_sheet <- sum_depth_sheet %>%
  relocate(label, .after = level)




# BM: from my perspective, what would be ideal here is to have the 
# excavation area and volume calculations done here in R. I feel anxious about
# the possibilities of typos when these values are calculated somewhere I can't 
# see and pasted into the google sheet. I prefer for the workflow of calculations
# to be as transparent and traceable as possible. From this point in the qmd I
# think we can use the volume values from this google sheet. Another option is to 
# export the google sheet as a CSV, and put that in the data folder in this project. 
# Then we can use read_csv to import it. 



#SS: is that true?: (I have a weird number in row 5, cl Depth and couldn't find out what happened)





#### previously I had a column'excavation area'; I seprated them in 2 columns in order to calculate the colume; but now when I wanted to run the code it said "! object 'excavation area' not found"; would it be OK to delete these lines? 

# Separate `excavation area` into `length` and `width` and calculate `volume`
sum_depth_sheet <- sum_depth_sheet %>%
  separate(`excavation area`, into = c("length", "width"), sep = "\\*") %>%
  mutate(
    length = as.numeric(length),
    width = as.numeric(width),
    `thickness` = `thickness` / 100  # Convert from cm to m
  ) %>%
  mutate(
    volume = length * width * `thickness`  # Calculate volume in m^3
  )


# Calculate lithic volumetric density 
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(
    `lithic_dens` = round(total_lithics / volume, 2)
  )

# Calculate retouch frequency 
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(
    retouch_freq = round(retouch_tool / volume, 2)  
  )
# Create the plot: WABI_Level_logscale
# here I do not consider those levels with a value 0 of retouch frequency. 
filtered_data <- sum_depth_sheet %>% 
  filter(lithic_dens > 0 & retouch_freq > 0)




WABI_Level <- ggplot(filtered_data,  
            aes(x = lithic_dens,
                y = retouch_freq)) +
  geom_point(color = "black", size = 1.5) +
  geom_smooth(method = "lm", 
              se = TRUE, 
              color = "blue", 
              linewidth = 0.5) +
  # Add text labels based on 'label' column
  geom_text(aes(label = label), 
            vjust = 1.5, 
            hjust = 0.5, 
            check_overlap = TRUE) +
  
  stat_poly_eq(aes(label = paste(stat(eq.label), 
                                  stat(rr.label), 
                                  stat(p.value.label), 
                                  sep = "~~~")),
               formula = y ~ x, 
               parse = TRUE, 
               size = 4) +
  labs(
    title = "Relationship between Retouch Frequency and Lithic Volumetric Density",
    x = "Lithic Volumetric Density",
    y = "Retouch Frequency"
  ) +
  scale_x_log10() +
  scale_y_log10() +
  theme(
    axis.text = element_text(size = 7),
    axis.title = element_text(size = 10),
    plot.title = element_text(size = 12)
  )

# Print the plot to display it
print(WABI_Level)

#PCA_Level: preparing data

#PCA_level: for PCA Bicho and Cascalheira considered these variables: estimated area (as we calculated based on levels, I consider the thickness; is that OK?), core frequency, blank frequency, chip frequency: artefacts smaller than 1 cm (as we work on a neolithic asssemblage, we have so many small artefacts; so, I do not consider it), feature frequency (we have some stone alignments, but we do not know the exact level, we know the area of those features), retouch frequency, tool diversity (diversity of tool types within each assemblage, calculated using Menhinick’s index); 
##core frequency
##blank frequency
##retouch frequency
##tool diversity
##thickness of deposit (???)
##lithic density



#Calculate Core Frequency
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(
    core_freq = round(cores / volume, 2)  
  )

# calculate Blank Frequency
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(
    blank_freq = round((flake + blade + bladelet) / volume, 2)  
  )

# Calculate tool diversity using Menhinick's index
sum_depth_sheet <- sum_depth_sheet %>%
  mutate(
    total_tools = retouch_tool + utilized + sickle_shine,
    tool_diversity = ifelse(total_tools > 0, n_distinct(tool_type) / sqrt(total_tools), NA)
  )
pca_data <- sum_depth_sheet %>% 
  select(lithic_dens, core_freq, blank_freq, retouch_freq, tool_diversity) %>%
  na.omit()  # Remove rows with NA values
# performin PCA

library(FactoMineR)
library(factoextra)

pca_data <- sum_depth_sheet[, c('lithic_dens', 'core_freq', 'blank_freq', 'retouch_freq', 'tool_diversity')]

# Perform PCA
res.pca <- PCA(pca_data, graph = FALSE)

# View the summary results
summary(res.pca)

Call:
PCA(X = pca_data, graph = FALSE) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5
Variance               3.318   0.836   0.739   0.105   0.001
% of var.             66.367  16.721  14.781   2.109   0.023
Cumulative % of var.  66.367  83.088  97.868  99.977 100.000

Individuals (the 10 first)
                   Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
1              |  8.074 |  7.299 38.222  0.817 |  2.273 14.720  0.079 | -2.501
2              |  5.082 |  3.817 10.451  0.564 | -0.852  2.067  0.028 |  3.199
3              |  1.382 | -1.328  1.265  0.923 | -0.327  0.305  0.056 | -0.181
4              |  1.155 |  0.134  0.013  0.013 | -0.859  2.102  0.553 | -0.752
5              |  1.257 | -1.236  1.096  0.968 |  0.207  0.122  0.027 | -0.008
6              |  2.464 | -1.964  2.769  0.635 |  1.348  5.173  0.299 |  0.596
7              |  1.392 | -1.337  1.283  0.923 | -0.330  0.311  0.056 | -0.179
8              |  1.392 | -1.337  1.283  0.923 | -0.330  0.311  0.056 | -0.179
9              |  1.438 | -1.379  1.365  0.920 | -0.346  0.341  0.058 | -0.175
10             |  2.334 | -1.736  2.163  0.553 |  1.442  5.921  0.382 |  0.539
                  ctr   cos2  
1              20.149  0.096 |
2              32.976  0.396 |
3               0.105  0.017 |
4               1.822  0.424 |
5               0.000  0.000 |
6               1.143  0.058 |
7               0.104  0.017 |
8               0.104  0.017 |
9               0.098  0.015 |
10              0.935  0.053 |

Variables
                  Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
lithic_dens    |  0.977 28.753  0.954 |  0.178  3.809  0.032 | -0.068  0.625
core_freq      |  0.583 10.228  0.339 | -0.275  9.023  0.075 |  0.764 78.918
blank_freq     |  0.967 28.154  0.934 |  0.185  4.080  0.034 | -0.039  0.206
retouch_freq   |  0.923 25.646  0.851 |  0.218  5.675  0.047 | -0.191  4.933
tool_diversity | -0.489  7.219  0.240 |  0.804 77.413  0.647 |  0.336 15.318
                 cos2  
lithic_dens     0.005 |
core_freq       0.583 |
blank_freq      0.002 |
retouch_freq    0.036 |
tool_diversity  0.113 |
#Plot: Contribution of variables for each of the four relevant PCA dimensions
library(factoextra)
library(ggplot2)

#save contribution plots into one objects
p1 <- fviz_contrib(res.pca, 
                   choice = "var", 
                   axes = 1, 
                   top = 10)
p2 <- fviz_contrib(res.pca, 
                   choice = "var",
                   axes = 2, 
                   top = 10)
p3 <- fviz_contrib(res.pca, 
                   choice = "var", 
                   axes = 3, 
                   top = 10)
p4 <- fviz_contrib(res.pca, 
                   choice = "var", 
                   axes = 4, 
                   top = 10)

#combine individual plots into one plot 
library(gridExtra)
grid.arrange(p1, p2, p3, p4, ncol = 2)

# Extract contributions of variables to each principal component
contributions <- res.pca$var$contrib

# Compute average contribution for each dimension
avg_contrib_dim1 <- mean(contributions[,1], na.rm = TRUE)
avg_contrib_dim2 <- mean(contributions[,2], na.rm = TRUE)
avg_contrib_dim3 <- mean(contributions[,3], na.rm = TRUE)
avg_contrib_dim4 <- mean(contributions[,4], na.rm = TRUE)

# Find variables that contribute more than average to each dimension
high_contrib_dim1 <- contributions[contributions[,1] > avg_contrib_dim1, 1]
high_contrib_dim2 <- contributions[contributions[,2] > avg_contrib_dim2, 2]
high_contrib_dim3 <- contributions[contributions[,3] > avg_contrib_dim3, 3]
high_contrib_dim4 <- contributions[contributions[,4] > avg_contrib_dim4, 4]

# Sort them in descending order
sorted_high_contrib_dim1 <- sort(high_contrib_dim1, decreasing = TRUE)
sorted_high_contrib_dim2 <- sort(high_contrib_dim2, decreasing = TRUE)
sorted_high_contrib_dim3 <- sort(high_contrib_dim3, decreasing = TRUE)
sorted_high_contrib_dim4 <- sort(high_contrib_dim4, decreasing = TRUE)

# Print or use for further analysis
print("Significant contributions to Dim1:")
[1] "Significant contributions to Dim1:"
print(sorted_high_contrib_dim1)
 lithic_dens   blank_freq retouch_freq 
    28.75326     28.15377     25.64583 
print("Significant contributions to Dim2:")
[1] "Significant contributions to Dim2:"
print(sorted_high_contrib_dim2)
[1] 77.41307
print("Significant contributions to Dim3:")
[1] "Significant contributions to Dim3:"
print(sorted_high_contrib_dim3)
[1] 78.91811
print("Significant contributions to Dim4:")
[1] "Significant contributions to Dim4:"
print(sorted_high_contrib_dim4)
retouch_freq   blank_freq 
    61.69980     28.14572 
# screeplot; inspect distribution of PCs
library(factoextra)  
fviz_screeplot(res.pca)

# Inspect eigenvalues
print(res.pca$eig)
        eigenvalue percentage of variance cumulative percentage of variance
comp 1 3.318338642            66.36677284                          66.36677
comp 2 0.836040202            16.72080403                          83.08758
comp 3 0.739034840            14.78069681                          97.86827
comp 4 0.105453164             2.10906327                          99.97734
comp 5 0.001133152             0.02266304                         100.00000
eigen_df <- data.frame(
  eigenvalue = res.pca$eig[,1],
  `percentage of variance` = res.pca$eig[,2],
  `cumulative percentage of variance` = res.pca$eig[,3]
)
library(kableExtra)
library(htmltools)

# Create a new column named "Dimension"
eigen_df$Dimension <- paste("Dim", seq_len(nrow(eigen_df)), sep = "")

# Re-order the columns based on the corrected names
eigen_df <- eigen_df[, c("Dimension", "eigenvalue", "percentage.of.variance", "cumulative.percentage.of.variance")]

# Round the numerical columns to 3 decimal places
eigen_df[, 2:4] <- round(eigen_df[, 2:4], 3)

# Removing row names
rownames(eigen_df) <- NULL  

# Creating the kable output
kable_output <- kable(eigen_df, 
                      "html", 
                      align = 'c', 
                      col.names = c("Dimension", 
                                    "Eigenvalue", 
                                    "Variance Percent", 
                                    "Cumulative Variance Percent")) %>%
  kable_styling("striped", 
                full_width = F) %>%
  add_header_above(c(" " = 1, "Eigenvalues and percentage of variance for each dimension of PCA" = 3))

# Display the table
htmltools::browsable(kable_output)
Eigenvalues and percentage of variance for each dimension of PCA
Dimension Eigenvalue Variance Percent Cumulative Variance Percent
Dim1 3.318 66.367 66.367
Dim2 0.836 16.721 83.088
Dim3 0.739 14.781 97.868
Dim4 0.105 2.109 99.977
Dim5 0.001 0.023 100.000
# Visualize biplot:1
fviz_pca_biplot(res.pca,
                axes = c(1, 2),
                labelsize = 2
                )

rownames(res.pca$ind$coord) <- sum_depth_sheet$label
# Visualize biplot: 2
fviz_pca_biplot(res.pca,
                axes = c(3, 4),
                labelsize = 2
                )

rownames(res.pca$ind$coord) <- sum_depth_sheet$label